home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 2 / AACD 2.iso / AACD / Programming / fpc / compiler / symtable.pas < prev    next >
Pascal/Delphi Source File  |  1998-09-24  |  196KB  |  6,910 lines
  1. {
  2.     $Id: symtable.pas,v 1.1.1.1.2.4 1998/08/13 17:41:28 florian Exp $
  3.     Copyright (c) 1993-98 by Florian Klaempfl, Pierre Muller
  4.  
  5.     This unit handles the symbol tables
  6.  
  7.     This program is free software; you can redistribute it and/or modify
  8.     it under the terms of the GNU General Public License as published by
  9.     the Free Software Foundation; either version 2 of the License, or
  10.     (at your option) any later version.
  11.  
  12.     This program is distributed in the hope that it will be useful,
  13.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  14.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15.     GNU General Public License for more details.
  16.  
  17.     You should have received a copy of the GNU General Public License
  18.     along with this program; if not, write to the Free Software
  19.     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20.  
  21.  ****************************************************************************
  22. }
  23. unit symtable;
  24.  
  25.   interface
  26.  
  27.     uses
  28.        objects,cobjects,verbose,systems,globals,strings,aasm,files,link
  29. {$ifdef i386}
  30.        ,i386
  31. {$endif}
  32. {$ifdef m68k}
  33.        ,m68k
  34. {$endif}
  35. {$ifdef alpha}
  36.        ,alpha
  37. {$endif}
  38. {$ifdef GDB}
  39.        ,gdb
  40. {$endif}
  41. {$ifdef UseBrowser}
  42.        ,browser
  43. {$endif UseBrowser}
  44.        ;
  45.  
  46.     const
  47. {$ifdef FPC}
  48.        ppubufsize=32768;
  49. {$ELSE}
  50.     {$IFDEF USEOVERLAY}
  51.        ppubufsize=512;
  52.     {$ELSE}
  53.        ppubufsize=4096;
  54.     {$ENDIF}
  55. {$ENDIF}
  56.        { possible types of symtables }
  57.        { changed in two field
  58.        one for the lexlevel
  59.        and one for the symtabletype (PM)
  60.        localsymtable = $8000;
  61.        parasymtable = $4000;
  62.        locallevel = $3fff;
  63.        withsymtable = 1;
  64.        staticsymtable = 2;
  65.        globalsymtable = 3;
  66.        unitsymtable = 4;
  67.        objectsymtable = 5;
  68.        recordsymtable = 6;
  69.        macrosymtable = 7;
  70.        localsymtable = 8;
  71.        parasymtable = 9;}
  72.  
  73.     type
  74.        tsymtabletype = (withsymtable,staticsymtable,
  75.                         globalsymtable,unitsymtable,
  76.                         objectsymtable,recordsymtable,
  77.                         macrosymtable,localsymtable,
  78.                         parasymtable);
  79.  
  80.     const
  81.        { different options }
  82.        sp_public = 0;
  83.        sp_forwarddef = 1;
  84.        sp_protected = 2;
  85.        sp_private = 4;
  86.        sp_static = 8;
  87.  
  88.     type
  89.        symprop = byte;
  90.  
  91.     const
  92.        poexceptions     = $1;       {????}
  93.        povirtualmethod  = $2;       {Procedure is a virtual method.}
  94.        poclearstack     = $4;       {Use IBM flat calling convention. (Used
  95.                                      by GCC.)}
  96.        poconstructor    = $8;       {Procedure is a constructor.}
  97.        podestructor     = $10;      {Procedure is a constructor.}
  98.        pointernproc     = $20;      {????}
  99.        poexports        = $40;      {Procedure is exported.}
  100.        poiocheck        = $80;      {IO checking should be done after
  101.                                      a call to the procedure.}
  102.        poabstractmethod = $100;     {Procedure is an abstract method.}
  103.        pointerrupt      = $200;     {Procedure is an interrupt handler.}
  104.        poinline         = $400;     {Procedure is an assembler macro.}
  105.        poassembler      = $800;     {Procedure is written in assembler.}
  106.        pooperator       = $1000;    {Procedure defines an operator.}
  107.        poexternal       = $2000;    {Procedure is external. It is either in
  108.                                      a separate object file, or it is stored
  109.                                      in a dynamic link library. This is
  110.                                      determined by the fields of Tprocsym.}
  111.        poleftright      = $4000;    {Push parameters from left to right.
  112.                                      Currently unsupported.}
  113.        poproginit       = $8000;    {Program initialisation.}
  114.        { cdecl is the same as poclearstack }
  115.        pocdecl = poclearstack;
  116.        postaticmethod   = $10000;
  117.        pooverridingmethod=$20000;
  118.        poclassmethod    = $40000;
  119.        pounitinit       = $80000;    {unit initialisation.}
  120.        popalmossyscall  = $100000;
  121.  
  122.        hasharraysize = 97;
  123.  
  124.        { last operator which can be overloaded }
  125.        last_overloaded = ASSIGNMENT;
  126.  
  127.     const
  128.        { options for objects and classes }
  129.        oois_abstract = $1;
  130.        oois_class = $2;
  131.        oo_hasvirtual = $4;
  132.        oo_hasprivate = $8;
  133.        oo_hasprotected = $10;
  134.        oo_isforward = $20;
  135.  
  136.        { options for properties }
  137.        ppo_indexed = $1;
  138.        ppo_defaultproperty = $2;
  139.  
  140.     type
  141.        pword = ^word;
  142.  
  143.        { "forward" pointer }
  144.        pformaldef = ^tformaldef;
  145.        pfiledef = ^tfiledef;
  146.        pobjectdef = ^tobjectdef;
  147.        precdef = ^trecdef;
  148.        parraydef = ^tarraydef;
  149.        ppointerdef = ^tpointerdef;
  150.        pstringdef = ^tstringdef;
  151.        penumdef = ^tenumdef;
  152.        porddef = ^torddef;
  153.        pfloatdef = ^tfloatdef;
  154.        pprocdef = ^tprocdef;
  155.        perrordef = ^terrordef;
  156.        psetdef = ^tsetdef;
  157.        pclassrefdef = ^tclassrefdef;
  158.  
  159.        psymtable = ^tsymtable;
  160.        punitsymtable = ^tunitsymtable;
  161.  
  162.        pdef = ^tdef;
  163.        pprocvardef = ^tprocvardef;
  164.        pabstractprocdef = ^tabstractprocdef;
  165.        psym = ^tsym;
  166.        plabelsym = ^tlabelsym;
  167.        ppropertysym = ^tpropertysym;
  168.  
  169.        { base types }
  170.        tbasetype = (uauto,u8bit,s32bit,uvoid,bool8bit,uchar,
  171.                     s8bit,s16bit,u16bit,u32bit);
  172.  
  173.        { sextreal is dependant on the cpu, s64bit is also }
  174.        { dependant on the size (tp = 80bit for both)      }
  175.        { The EXTENDED format exists on the motorola FPU   }
  176.        { but it uses 96 bits instead of 80, with some     }
  177.        { unused bits within the number itself! Pretty     }
  178.        { complicated to support, so no support for the    }
  179.        { moment.                                          }
  180.        { s64 bit is considered as a real because all      }
  181.        { calculations are done by the fpu.                }
  182.        tfloattype = (f32bit,s32real,s64real,s80real,s64bit,f16bit);
  183.  
  184.        { possible types for symtable entries }
  185.        tsymtyp = (abstractsym,varsym,typesym,procsym,unitsym,programsym,
  186.                   constsym,enumsym,typedconstsym,errorsym,syssym,
  187.                   labelsym,absolutesym,propertysym,funcretsym);
  188.  
  189.        { added a new field for tdefcoll for firstcalln }
  190.        { convertable is if is_convertable returns true
  191.          equal is if is_equal returns true
  192.          exact is if the def is the same excatly }
  193.  
  194.        targconvtyp = (act_convertable,act_equal,act_exact);
  195.  
  196.        tvarspez = (vs_value,vs_const,vs_var);
  197.  
  198.        pdefcoll = ^tdefcoll;
  199.  
  200.        tdefcoll = record
  201.           data : pdef;
  202.           next : pdefcoll;
  203.           paratyp : tvarspez;
  204.           argconvtyp : targconvtyp;
  205.        end;
  206.  
  207.        { this object is the base for all symbol objects }
  208.        tsym = object
  209.           typ   : tsymtyp;
  210.           _name : pchar;
  211.           left  : psym;
  212.           right : psym;
  213.           speedvalue : longint;
  214.           properties : symprop;
  215.           owner : psymtable;
  216. {$ifdef UseBrowser}
  217.           lastref,defref,lastwritten : pref;
  218.           refcount : longint;
  219.           indexnb  : word; { this limit the number of symbols to
  220.           65000 per unit, should not be a big problem !! }
  221. {$endif UseBrowser}
  222. {$ifdef GDB}
  223.           isstabwritten : boolean;
  224. {$endif GDB}
  225.         {$ifdef tp}
  226.           line_no : word;
  227.         {$else}
  228.           line_no : longint;
  229.         {$endif}
  230.           constructor init(const n : string);
  231.           constructor load;
  232.           destructor done;virtual;
  233.           procedure write;virtual;
  234.           procedure deref;virtual;
  235.           function name : string;
  236.           function mangledname : string;virtual;
  237.           procedure setname(const s : string);
  238. {$ifdef GDB}
  239.           function stabstring : pchar;virtual;
  240.           procedure concatstabto(asmlist : paasmoutput);virtual;
  241. {$endif GDB}
  242. {$ifdef UseBrowser}
  243.           procedure load_references; virtual;
  244.           procedure write_references; virtual;
  245.           procedure write_external_references;
  246.           procedure write_ref_to_file(var f : text);
  247. {$endif UseBrowser}
  248.        end;
  249.  
  250.        tlabelsym = object(tsym)
  251.           number : plabel;
  252.           defined : boolean;
  253.           constructor init(const n : string; l : plabel);
  254.           destructor done;virtual;
  255.           function mangledname : string;virtual;
  256.           procedure write;virtual;
  257.        end;
  258.  
  259.        punitsym = ^tunitsym;
  260.  
  261.        tunitsym = object(tsym)
  262.           unitsymtable : punitsymtable;
  263.           prevsym : punitsym;
  264.           refs : longint;
  265.           constructor init(const n : string;ref : punitsymtable);
  266.           destructor done;virtual;
  267.           procedure write;virtual;
  268. {$ifdef GDB}
  269.           procedure concatstabto(asmlist : paasmoutput);virtual;
  270. {$endif GDB}
  271.        end;
  272.  
  273.        pmacrosym = ^tmacrosym;
  274.  
  275.        tmacrosym = object(tsym)
  276.           defined : boolean;
  277.           buftext : pchar;
  278.           buflen : longint;
  279.           { macros aren't written to PPU files ! }
  280.           constructor init(const n : string);
  281.           destructor done;virtual;
  282.        end;
  283.  
  284.        perrorsym = ^terrorsym;
  285.  
  286.        terrorsym = object(tsym)
  287.           constructor init;
  288.        end;
  289.  
  290.        pprocsym = ^tprocsym;
  291.  
  292.        tprocsym = object(tsym)
  293.           definition : pprocdef;
  294. {$ifdef CHAINPROCSYMS}
  295.           nextprocsym : pprocsym;
  296. {$endif CHAINPROCSYMS}
  297. {$ifdef GDB}
  298.           is_global : boolean;{necessary for stab}
  299. {$endif GDB}
  300.           constructor init(const n : string);
  301.           constructor load;
  302.           destructor done;virtual;
  303.           function mangledname : string;virtual;
  304.           { tests, if all procedures definitions are defined and not }
  305.           { only forward                                             }
  306.           procedure check_forward;
  307.           procedure write;virtual;
  308.           procedure deref;virtual;
  309. {$ifdef GDB}
  310.           function stabstring : pchar;virtual;
  311.           procedure concatstabto(asmlist : paasmoutput);virtual;
  312. {$endif GDB}
  313.        end;
  314.  
  315.        ptypesym = ^ttypesym;
  316.  
  317.        ttypesym = object(tsym)
  318.           definition : pdef;
  319.           forwardpointer : ppointerdef;
  320. {$ifdef GDB}
  321.           isusedinstab : boolean;
  322. {$endif GDB}
  323.           constructor init(const n : string;d : pdef);
  324.           constructor load;
  325.           destructor done;virtual;
  326.           procedure write;virtual;
  327.           procedure deref;virtual;
  328. {$ifdef GDB}
  329.           function stabstring : pchar;virtual;
  330.           procedure concatstabto(asmlist : paasmoutput);virtual;
  331. {$endif GDB}
  332.        end;
  333.  
  334.        pvarsym = ^tvarsym;
  335.  
  336.        tvarsym = object(tsym)
  337.           address : longint;
  338.           definition : pdef;
  339.           refs : longint;
  340.           regable : boolean;
  341.  
  342.           { if reg<>R_NO, then the variable is an register variable }
  343.           reg : tregister;
  344.  
  345.           { sets the type of access }
  346.           varspez : tvarspez;
  347.           is_valid : byte;
  348.           constructor init(const n : string;p : pdef);
  349.           constructor load;
  350.           function mangledname : string;virtual;
  351.           function getsize : longint;
  352.           procedure write;virtual;
  353.           procedure deref;virtual;
  354. {$ifdef GDB}
  355.           function stabstring : pchar;virtual;
  356.           procedure concatstabto(asmlist : paasmoutput);virtual;
  357. {$endif GDB}
  358.        end;
  359.  
  360.        tpropertysym = object(tsym)
  361.           options : longint;
  362.           proptype : pdef;
  363.           { proppara : pdefcoll; }
  364.           readaccesssym,writeaccesssym : psym;
  365.           readaccessdef,writeaccessdef : pdef;
  366.           index : longint;
  367.           constructor init(const n : string);
  368.           destructor done;virtual;
  369.           constructor load;
  370.           function getsize : longint;virtual;
  371.           procedure write;virtual;
  372.           procedure deref;virtual;
  373. {$ifdef GDB}
  374.           { I don't know how }
  375.           function stabstring : pchar;virtual;
  376.           procedure concatstabto(asmlist : paasmoutput);virtual;
  377. {$endif GDB}
  378.        end;
  379.  
  380. {$ifdef TEST_FUNCRET}
  381.        pfuncretsym = ^tfuncretsym;
  382.  
  383.        tfuncretsym = object(tsym)
  384.           funcretprocinfo : pprocinfo;
  385.           funcretdef : pdef;
  386.           address : longint;
  387.           constructor init(const n : string;approcinfo : pprocinfo);
  388.        end;
  389. {$endif TEST_FUNCRET}
  390.  
  391.        pabsolutesym = ^tabsolutesym;
  392.  
  393.        absolutetyp = (tovar,toasm,toaddr);
  394.  
  395.        tabsolutesym = object(tvarsym)
  396.           abstyp : absolutetyp;
  397.           absseg : boolean;
  398.           ref : psym;
  399.           asmname : pstring;
  400.           { this creates a problem in gen_vmt !!!!!
  401.           because the pdef is not resolved yet !!
  402.           we should fix this }
  403.           constructor load;
  404.           procedure deref;virtual;
  405.           function mangledname : string;virtual;
  406.           procedure write;virtual;
  407.           {constructor init(const s : string;p : pdef;newref : psym);}
  408. {$ifdef GDB}
  409.           procedure concatstabto(asmlist : paasmoutput);virtual;
  410. {$endif GDB}
  411.        end;
  412.  
  413.        ptypedconstsym = ^ttypedconstsym;
  414.  
  415.        ttypedconstsym = object(tsym)
  416.           prefix : pstring;
  417.           definition : pdef;
  418.           constructor init(const n : string;p : pdef);
  419.           constructor load;
  420.           destructor done;virtual;
  421.           function mangledname : string;virtual;
  422.           procedure write;virtual;
  423.           procedure deref;virtual;
  424. {$ifdef GDB}
  425.           function stabstring : pchar;virtual;
  426. {$endif GDB}
  427.        end;
  428.  
  429.        tconsttype = (constord,conststring,constreal,constbool,constint,
  430.          constchar,constseta);
  431.  
  432.        pconstsym = ^tconstsym;
  433.  
  434.        tconstsym = object(tsym)
  435.           definition : pdef;
  436.           consttype : tconsttype;
  437.           value : longint;
  438.           constructor init(const n : string;t : tconsttype;v : longint;def : pdef);
  439.           constructor load;
  440.           function mangledname : string;virtual;
  441. {$ifdef GDB}
  442.           destructor done;virtual;
  443. {$endif GDB}
  444.           procedure deref;virtual;
  445.           procedure write;virtual;
  446. {$ifdef GDB}
  447.           function stabstring : pchar;virtual;
  448.           procedure concatstabto(asmlist : paasmoutput);virtual;
  449. {$endif GDB}
  450.        end;
  451.  
  452.        penumsym = ^tenumsym;
  453.  
  454.        tenumsym = object(tsym)
  455.           value : longint;
  456.           definition : penumdef;
  457.           next : penumsym;
  458.           constructor init(const n : string;def : penumdef;v : longint);
  459.           constructor load;
  460.           procedure write;virtual;
  461.           procedure deref;virtual;
  462. {$ifdef GDB}
  463.           procedure order;
  464.           procedure concatstabto(asmlist : paasmoutput);virtual;
  465. {$endif GDB}
  466.        end;
  467.  
  468.        pprogramsym = ^tprogramsym;
  469.  
  470.        tprogramsym = object(tsym)
  471.           constructor init(const n : string);
  472.        end;
  473.  
  474.        psyssym = ^tsyssym;
  475.  
  476.        tsyssym = object(tsym)
  477.           number : longint;
  478.           constructor init(const n : string;l : longint);
  479.           procedure write;virtual;
  480. {$ifdef GDB}
  481.           procedure concatstabto(asmlist : paasmoutput);virtual;
  482. {$endif GDB}
  483.        end;
  484.  
  485.        tcallback = procedure(p : psym);
  486.  
  487.        tsymtablehasharray = array[0..hasharraysize-1] of psym;
  488.  
  489.        psymtablehasharray = ^tsymtablehasharray;
  490.  
  491.        tsymtable = object
  492.           name : pstring;
  493.           datasize : longint;
  494.           wurzel : psym;
  495.           hasharray : psymtablehasharray;
  496.           next : psymtable;
  497.  
  498.           defowner : pdef; { for records and objects }
  499.  
  500.           { only used for parameter symtable to determine the offset relative }
  501.           { to the frame pointer                                              }
  502.           call_offset : longint;
  503.  
  504.           { this saves all definition to allow a proper clean up }
  505.           wurzeldef : pdef;
  506.           symtabletype : tsymtabletype;
  507.           { separate lexlevel from symtable type }
  508.           symtablelevel : byte;
  509.  
  510.           { each symtable gets a number }
  511.           unitid : word;
  512.  
  513.           constructor init(t : tsymtabletype);
  514.           constructor load;
  515.           constructor loadasstruct(typ : tsymtabletype);
  516.           destructor done;virtual;
  517.           procedure check_forwards;
  518.           procedure insert(sym : psym);
  519.           function search(const s : stringid) : psym;
  520.           procedure clear;
  521.           procedure registerdef(p : pdef);
  522.           procedure foreach(proc2call : tcallback);
  523.           procedure allsymbolsused;
  524.           procedure allunitsused;
  525. {$ifdef CHAINPROCSYMS}
  526.           procedure chainprocsyms;
  527. {$endif CHAINPROCSYMS}
  528.           procedure write;
  529.           procedure number_units;
  530.           procedure number_defs;
  531.           procedure writeasstruct;
  532.           function getdefnr(l : word) : pdef;
  533. {$ifdef UseBrowser}
  534.           function getsymnr(l : word) : psym;
  535.           procedure number_symbols;
  536.           procedure write_external_references;
  537. {$endif UseBrowser}
  538. {$ifdef GDB}
  539.           procedure concatstabto(asmlist : paasmoutput);virtual;
  540. {$endif GDB}
  541.           function getnewtypecount : word; virtual;
  542.        end;
  543.  
  544.        tunitsymtable = object(tsymtable)
  545.           checksum,maschstart : longint;
  546.           dbx_count : longint;
  547.           is_stab_written : boolean;
  548.           prev_dbx_counter : plongint;
  549.           dbx_count_ok : boolean;
  550.           unittypecount  : word;
  551.           unitsym : punitsym;
  552.  
  553.           constructor init(t : tsymtabletype;const n : string);
  554.           constructor load(const n : string);
  555.           procedure writeasunit;
  556. {$ifdef GDB}
  557.           procedure orderdefs;
  558.           procedure concattypestabto(asmlist : paasmoutput);
  559. {$endif GDB}
  560.           function getnewtypecount : word; virtual;
  561.        end;
  562.  
  563.        { definition contains the informations about a type }
  564.        tdeftype = (abstractdef,arraydef,recorddef,pointerdef,orddef,
  565.                    stringdef,enumdef,procdef,objectdef,errordef,
  566.                    filedef,formaldef,setdef,procvardef,floatdef,
  567.                    classrefdef);
  568.  
  569.        tdef = object
  570.           savesize : longint;
  571.           owner : psymtable;
  572.           { this allows to determine by which type the definition was generated }
  573.           sym : ptypesym;
  574.           next : pdef;
  575. {$ifdef GDB}
  576.           globalnb : word;
  577.           nextglobal : pdef;
  578.           {StabType : word;}
  579.           isstabwritten : boolean;
  580. {$endif GDB}
  581.           number : word;
  582.           deftype : tdeftype;
  583.  
  584.           function size : longint;virtual;
  585. {$ifdef GDB}
  586.           function NumberString : string;
  587. {$endif GDB}
  588.           constructor init;
  589. {$ifdef GDB}
  590.           constructor load;
  591.           procedure set_globalnb;
  592. {$endif GDB}
  593.           destructor done;virtual;
  594.           procedure write;virtual;
  595. {$ifdef GDB}
  596.           function stabstring : pchar;virtual;
  597.           function allstabstring : pchar;
  598.           procedure concatstabto(asmlist : paasmoutput);virtual;
  599. {$endif GDB}
  600.           procedure deref;virtual;
  601.        end;
  602.  
  603.        tfiletype = (ft_text,ft_typed,ft_untyped);
  604.  
  605.        tfiledef = object(tdef)
  606.           public
  607.              filetype : tfiletype;
  608.              typed_as : pdef;
  609.              constructor init(ft : tfiletype;tas : pdef);
  610.              constructor load;
  611.              procedure write;virtual;
  612. {$ifdef GDB}
  613.              function stabstring : pchar;virtual;
  614.              procedure concatstabto(asmlist : paasmoutput);virtual;
  615. {$endif GDB}
  616.              procedure deref;virtual;
  617.           {private}
  618.              procedure setsize;
  619.        end;
  620.  
  621.        tformaldef = object(tdef)
  622.           constructor init;
  623.           constructor load;
  624.           procedure write;virtual;
  625. {$ifdef GDB}
  626.           function stabstring : pchar;virtual;
  627.           procedure concatstabto(asmlist : paasmoutput);virtual;
  628. {$endif GDB}
  629.        end;
  630.  
  631.        terrordef = object(tdef)
  632.           constructor init;
  633. {$ifdef GDB}
  634.           function stabstring : pchar;virtual;
  635. {$endif GDB}
  636.        end;
  637.  
  638.        { tpointerdef and tclassrefdef should get a common
  639.          base class, but I derived tclassrefdef from tpointerdef
  640.          to avoid problems with bugs (FK)
  641.        }
  642.  
  643.        tpointerdef = object(tdef)
  644.           definition : pdef;
  645.           defsym : ptypesym;
  646.           constructor init(def : pdef);
  647.           constructor load;
  648.           procedure write;virtual;
  649. {$ifdef GDB}
  650.           function stabstring : pchar;virtual;
  651.           procedure concatstabto(asmlist : paasmoutput);virtual;
  652. {$endif GDB}
  653.           procedure deref;virtual;
  654.        end;
  655.  
  656.        tclassrefdef = object(tpointerdef)
  657.           constructor init(def : pdef);
  658.           constructor load;
  659.           procedure write;virtual;
  660. {$ifdef GDB}
  661.           function stabstring : pchar;virtual;
  662.           procedure concatstabto(asmlist : paasmoutput);virtual;
  663. {$endif GDB}
  664.        end;
  665.  
  666.        tarraydef = object(tdef)
  667.           lowrange : longint;
  668.           highrange : longint;
  669.           rangenr : longint;
  670.           definition : pdef;
  671.           rangedef : pdef;
  672.           function elesize : longint;
  673.           constructor init(l,h : longint;rd : pdef);
  674.           constructor load;
  675.           procedure write;virtual;
  676. {$ifdef GDB}
  677.           function stabstring : pchar;virtual;
  678.           procedure concatstabto(asmlist : paasmoutput);virtual;
  679. {$endif GDB}
  680.           procedure deref;virtual;
  681.           function size : longint;virtual;
  682.  
  683.           { generates the ranges needed by the asm instruction BOUND (i386)
  684.             or CMP2 (Motorola) }
  685.           procedure genrangecheck;
  686.        end;
  687.  
  688.        trecdef = object(tdef)
  689.           symtable : psymtable;
  690.           constructor init(p : psymtable);
  691.           constructor load;
  692.           destructor done;virtual;
  693.           procedure write;virtual;
  694. {$ifdef GDB}
  695.           function stabstring : pchar;virtual;
  696.           procedure concatstabto(asmlist : paasmoutput);virtual;
  697. {$endif GDB}
  698.           procedure deref;virtual;
  699.        end;
  700.  
  701.        torddef = object(tdef)
  702.           von : longint;
  703.           bis : longint;
  704.           rangenr : longint;
  705.           typ : tbasetype;
  706.           constructor init(t : tbasetype;v,b : longint);
  707.           constructor load;
  708.           procedure write;virtual;
  709. {$ifdef GDB}
  710.           function stabstring : pchar;virtual;
  711. {$endif GDB}
  712.           procedure setsize;
  713.  
  714.           { generates the ranges needed by the asm instruction BOUND }
  715.           { or CMP2 (Motorola)                                       }
  716.           procedure genrangecheck;
  717.        end;
  718.  
  719.        tfloatdef = object(tdef)
  720.           typ : tfloattype;
  721.           constructor init(t : tfloattype);
  722.           constructor load;
  723.           procedure write;virtual;
  724. {$ifdef GDB}
  725.           function stabstring : pchar;virtual;
  726. {$endif GDB}
  727.           procedure setsize;
  728.        end;
  729.  
  730.        tabstractprocdef = object(tdef)
  731.           { saves a definition to the return type }
  732.           retdef : pdef;
  733.           { save the procedure options }
  734.           options : longint;
  735.           para1 : pdefcoll;
  736.           constructor init;
  737.           constructor load;
  738.           destructor done;virtual;
  739.           procedure concatdef(p : pdef;vsp : tvarspez);
  740.           procedure deref;virtual;
  741. {$ifdef GDB}
  742.           function stabstring : pchar;virtual;
  743.           procedure concatstabto(asmlist : paasmoutput);virtual;
  744. {$endif GDB}
  745.           procedure write;virtual;
  746.        end;
  747.  
  748.        tprocvardef = object(tabstractprocdef)
  749.           constructor init;
  750.           constructor load;
  751.           procedure write;virtual;
  752. {$ifdef GDB}
  753.           function stabstring : pchar;virtual;
  754.           procedure concatstabto(asmlist : paasmoutput); virtual;
  755. {$endif GDB}
  756.        end;
  757.  
  758.        tprocdef = object(tabstractprocdef)
  759.           extnumber : longint;
  760.           nextoverloaded : pprocdef;
  761.           { pointer to the local symbol table }
  762.           localst : psymtable;
  763.           { pointer to the parameter symbol table }
  764.           parast : psymtable;
  765.  
  766. {$ifdef UseBrowser}
  767.           lastref,defref,lastwritten : pref;
  768.           refcount : longint;
  769. {$endif UseBrowser}
  770.  
  771.           _class : pobjectdef;
  772.           _mangledname : pchar;
  773.  
  774.           { it's a tree, but this not easy to handle }
  775.           { with the interfaces of units             }
  776.           code : pointer;
  777.  
  778.           { true, if the procedure is only declared }
  779.           { (forward procedure) }
  780.           forwarddef : boolean;
  781.  
  782.           { set which contains the modified registers }
  783. {$ifdef i386}
  784.           usedregisters : byte;
  785. {$endif}
  786. {$ifdef m68k}
  787.           usedregisters : word;
  788. {$endif}
  789. {$ifdef alpha}
  790.           usedregisters_int : longint;
  791.           usedregisters_fpu : longint;
  792. {$endif}
  793.           constructor init;
  794.           destructor done;virtual;
  795.           constructor load;
  796.           procedure write;virtual;
  797. {$ifdef GDB}
  798.           function cplusplusmangledname : string;
  799.           function stabstring : pchar;virtual;
  800.           procedure concatstabto(asmlist : paasmoutput);virtual;
  801. {$endif GDB}
  802.           procedure deref;virtual;
  803.           function mangledname : string;
  804.           procedure setmangledname(const s : string);
  805. {$ifdef UseBrowser}
  806.           procedure load_references; virtual;
  807.           procedure write_references; virtual;
  808.           procedure write_external_references;
  809.           procedure write_ref_to_file(var f : text);
  810. {$endif UseBrowser}
  811.        end;
  812.  
  813.        stringtype = (shortstring, longstring, ansistring);
  814.  
  815.        tstringdef = object(tdef)
  816.           string_typ : stringtype;
  817.           len : longint;
  818.           constructor init(l : byte);
  819.           constructor load;
  820. {$ifdef UseLongString}
  821.           constructor longinit(l : longint);
  822.           constructor longload;
  823. {$endif UseLongString}
  824. {$ifdef UseAnsiString}
  825.           constructor ansiinit(l : longint);
  826.           constructor ansiload;
  827. {$endif UseAnsiString}
  828.           function size : longint;virtual;
  829.           procedure write;virtual;
  830. {$ifdef GDB}
  831.           function stabstring : pchar;virtual;
  832.           procedure concatstabto(asmlist : paasmoutput);virtual;
  833. {$endif GDB}
  834.        end;
  835.  
  836.        tenumdef = object(tdef)
  837.           max : longint;
  838.           has_jumps : boolean;
  839.           first : penumsym;
  840.           constructor init;
  841.           constructor load;
  842.           destructor done;virtual;
  843.           procedure write;virtual;
  844. {$ifdef GDB}
  845.           function stabstring : pchar;virtual;
  846. {$endif GDB}
  847.        end;
  848.  
  849.        tobjectdef = object(tdef)
  850.           childof : pobjectdef;
  851.           name : pstring;
  852.           { privatesyms : psymtable;
  853.           protectedsyms : psymtable; }
  854.           publicsyms : psymtable;
  855.           options : longint;
  856.           constructor init(const n : string;c : pobjectdef);
  857.           destructor done;virtual;
  858.           procedure check_forwards;
  859.           function isrelated(d : pobjectdef) : boolean;
  860.           function size : longint;virtual;
  861.           constructor load;
  862.           procedure write;virtual;
  863.           function vmt_mangledname : string;
  864.           function isclass : boolean;
  865. {$ifdef GDB}
  866.           function stabstring : pchar;virtual;
  867. {$endif GDB}
  868.           procedure deref;virtual;
  869.        end;
  870.  
  871.        tsettype = (normset,smallset,varset);
  872.  
  873.        tsetdef = object(tdef)
  874.           setof : pdef;
  875.           settype : tsettype;
  876.           constructor init(s : pdef;high : longint);
  877.           constructor load;
  878.           procedure write;virtual;
  879. {$ifdef GDB}
  880.           function stabstring : pchar;virtual;
  881.           procedure concatstabto(asmlist : paasmoutput);virtual;
  882. {$endif GDB}
  883.           procedure deref;virtual;
  884.        end;
  885.  
  886.     { inits the symbol table administration }
  887.     procedure init_symtable;
  888.     procedure done_symtable;
  889.     procedure reset_gdb_info;
  890.  
  891.     { searches n in symtable of pd and all anchestors }
  892.     function search_class_member(pd : pobjectdef;const n : string) : psym;
  893.  
  894.     { returns the default property of a class, searches also anchestors }
  895.     function search_default_property(pd : pobjectdef) : ppropertysym;
  896.  
  897.     { get a global symbol }
  898.     function search_a_symtable(const symbol:string;symtabletype:tsymtabletype):Psym;
  899.     procedure getsym(const s : stringid;notfounderror : boolean);
  900.     procedure getsymonlyin(p : psymtable;const s : stringid);
  901.  
  902.     { writes an unit with the given name }
  903.     procedure writeunitas(const s : string;unit_symtable : punitsymtable);
  904.  
  905.     { deletes a symbol table from the symbol table stack }
  906.     procedure dellexlevel;
  907. {$ifdef DEBUG}
  908.     procedure test_symtablestack;
  909. {$endif DEBUG}
  910.     { saves a forward pointer defintion .... }
  911.     procedure save_forward(ppd : ppointerdef;typesym : ptypesym);
  912.  
  913.     { .... resolves this forward definitions }
  914.     procedure resolve_forwards;
  915.  
  916.     var
  917.        { for STAB debugging }
  918.        globaltypecount : word;
  919.        pglobaltypecount : pword;
  920.  
  921.        registerdef : boolean;      { true, wenn Definitionen           }
  922.                                    { registriert werden sollen         }
  923.  
  924.        symtablestack : psymtable;  { Wurzel der verketteten Liste von  }
  925.                                    { Symboltabellen                    }
  926.  
  927.        srsym : psym;               { enth„lt das Ergebnis der letzten  }
  928.        srsymtable : psymtable;     { Suche nach einem Symbol           }
  929.  
  930.        forwardsallowed : boolean;  { true, wenn Pointertypen "forward" }
  931.                                    { eingefgt werden drfen           }
  932.  
  933.        constsymtable : psymtable;  { Symboltabelle in die die          }
  934.                                    { Konstanten von z.B. Aufz„hlungs-  }
  935.                                    { typen eingefgt werden            }
  936.  
  937.        voiddef : porddef;          { Zeiger auf eine void-Definition   }
  938.                                    { wird von quelltext initialisiert  }
  939.                                    { (ist resulttype einer Procedure)  }
  940.        voidpointerdef : ppointerdef;
  941.                                    { Zeiger auf "void"-Pointerdef      }
  942.  
  943.        u32bitdef : porddef;        { Zeiger fr resulttype von         }
  944.        s32bitdef : porddef;        { Zeiger fr resulttype von         }
  945.                                    { intconstn                         }
  946.  
  947.        u8bitdef : porddef;         { Pointer auf 8-Bit unsigned        }
  948.        u16bitdef : porddef;        { Pointer auf 16-Bit unsigned        }
  949.  
  950.        c64floatdef : pfloatdef;    { Zeiger fr resulttype von         }
  951.                                    { realconstn                        }
  952.        s80floatdef : pfloatdef;    { pointer to type of temp. floats   }
  953.  
  954.        s32fixeddef : pfloatdef;    { pointer to type of temp. fixed    }
  955.  
  956.        cstringdef : pstringdef;    { pointer to type of short string const   }
  957.  
  958. {$ifdef UseLongString}
  959.        clongstringdef : pstringdef; { pointer to type of long string const   }
  960. {$endif UseLongString}
  961.  
  962. {$ifdef UseAnsiString}
  963.        cansistringdef : pstringdef;  { pointer to type of ansi string const  }
  964. {$endif UseAnsiString}
  965.  
  966.        cchardef : porddef;       { Zeiger fr resulttype von         }
  967.                                    { charconstn                        }
  968.  
  969.        cfiledef : pfiledef;       { get the same definition for all file }
  970.                                   { uses for stabs }
  971.        firstglobaldef, lastglobaldef : pdef;
  972.  
  973.        class_tobject : pobjectdef; { pointer to the anchestor of all   }
  974.                                    { clases                            }
  975.  
  976.        booldef : porddef;        { pointer to boolean type           }
  977.  
  978.        aktprocsym : pprocsym;      { Zeiger auf den Symboltablellen-   }
  979.                                    { eintrag der momentan geparseten   }
  980.                                    { procedure                         }
  981.  
  982.        procprefix : string;        { eindeutige Namen bei geschachtel- }
  983.                                    { ten Unterprogrammen erzeugen      }
  984.  
  985.        lexlevel : longint;         { level of code                     }
  986.                                    { 1 for main procedure              }
  987.                                    { 2 for normal function or proc     }
  988.                                    { higher for locals                 }
  989.  
  990.        macros : psymtable;         { Zeiger auf die Symboltabelle mit  }
  991.                                    { Makros                            }
  992.  
  993.        read_member : boolean;      { true, wenn Members aus einer PPU-  }
  994.                                    { Datei gelesen werden, d.h. ein     }
  995.                                    { varsym seine Adresse einlesen soll }
  996.  
  997.        generrorsym : psym;         { Jokersymbol, wenn das richtige    }
  998.                                    { Symbol nicht gefunden wird        }
  999.  
  1000.        generrordef : pdef;         { Jokersymbol fr eine fehlerhafte  }
  1001.                                    { Typdefinition                     }
  1002.  
  1003.        aktobjectdef : pobjectdef;  { used for private functions check !! }
  1004.  
  1005.        overloaded_operators : array[PLUS..last_overloaded] of pprocsym;
  1006.       { unequal is not equal}
  1007.     const
  1008.        overloaded_names : array [PLUS..last_overloaded] of string[16] =
  1009.          ('plus','minus','star','slash','equal',
  1010.           'greater','lower','greater_or_equal',
  1011.           'lower_or_equal','as','is','in','sym_diff',
  1012.           'caret','assign');
  1013.  
  1014. {$ifdef GDB}
  1015.     function typeglobalnumber(const s : string) : string;
  1016. {$endif GDB}
  1017.  
  1018.     function globaldef(const s : string) : pdef;
  1019.  
  1020.     procedure maybe_concat_external(symt : psymtable;const name : string);
  1021.  
  1022.        { pointer to the system unit, if the system unit is loaded }
  1023.    const systemunit : punitsymtable = nil;
  1024.          current_object_option : symprop = sp_public;
  1025. {$ifdef UseBrowser}
  1026.        use_browser  : boolean   = true;
  1027. {$endif UseBrowser}
  1028.  
  1029.  
  1030. implementation
  1031.  
  1032. {$ifdef TP}
  1033.   {$F+}
  1034. {$endif TP}
  1035.  
  1036.   var
  1037.        aktrecordsymtable : psymtable; { zeigt auf die Symboltabelle des }
  1038.                                       { Records, das momentan aus einer }
  1039.                                       { PPU-Datei gelesen wird          }
  1040.  
  1041.  
  1042.    {to dispose the global symtable of a unit }
  1043. const
  1044.     dispose_global: boolean =false;
  1045.     object_options : boolean = false;
  1046.     memsizeinc = 2048; { for long stabstrings }
  1047.     tagtypes : Set of tdeftype =
  1048.       [recorddef,enumdef,
  1049.       {$IfNDef GDBKnowsStrings}
  1050.       stringdef,
  1051.       {$EndIf not GDBKnowsStrings}
  1052.       {$IfNDef GDBKnowsFiles}
  1053.       filedef,
  1054.       {$EndIf not GDBKnowsFiles}
  1055.       objectdef];
  1056.  
  1057.     var
  1058.        { this is for a faster execution }
  1059.        ppufile : tbufferedfile;
  1060.  
  1061.     procedure writestring(s : string);
  1062.  
  1063.       begin
  1064.          ppufile.write_data(s,length(s)+1);
  1065.       end;
  1066.  
  1067.     procedure writeset(var s);      {You cannot pass an array[0..31]
  1068.                                      of byte!}
  1069.       begin
  1070.          ppufile.write_data(s,32);
  1071.       end;
  1072.  
  1073.     procedure writedefref(p : pdef);
  1074.  
  1075.       begin
  1076.          if p=nil then
  1077.        ppufile.write_long($ffffffff)
  1078.      else
  1079.        begin
  1080.           if (p^.owner^.symtabletype=recordsymtable) or
  1081.             (p^.owner^.symtabletype=objectsymtable) then
  1082.         ppufile.write_word($ffff)
  1083.           else ppufile.write_word(p^.owner^.unitid);
  1084.         ppufile.write_word(p^.number);
  1085.      end;
  1086.       end;
  1087.  
  1088. {$ifdef UseBrowser}
  1089.     procedure writesymref(p : psym);
  1090.  
  1091.       begin
  1092.          if p=nil then
  1093.            writelong($ffffffff)
  1094.          else
  1095.            begin
  1096.               if (p^.owner^.symtabletype=recordsymtable) or
  1097.                  (p^.owner^.symtabletype=objectsymtable) then
  1098.                 writeword($ffff)
  1099.               else writeword(p^.owner^.unitid);
  1100.               writeword(p^.indexnb);
  1101.            end;
  1102.       end;
  1103. {$endif UseBrowser}
  1104.  
  1105.     procedure writeunitas(const s : string;unit_symtable : punitsymtable);
  1106.  
  1107. {$ifdef UseBrowser}
  1108.       var
  1109.          pus : punitsymtable;
  1110. {$endif UseBrowser}
  1111.  
  1112.       begin
  1113.          Message1(unit_u_ppu_write,s);
  1114.  
  1115.        { open en init ppufile }
  1116.          ppufile.init(s,ppubufsize);
  1117.          ppufile.change_endian:=source_info.endian<>target_info.endian;
  1118.          ppufile.rewrite;
  1119.          if ioresult<>0 then
  1120.           Message(unit_f_ppu_cannot_write);
  1121.  
  1122.        { create and write header }
  1123.          unitheader[8]:=char(byte(target_info.target));
  1124.          if use_dbx then
  1125.            current_module^.flags:= current_module^.flags or uf_uses_dbx;
  1126. {$ifdef UseBrowser}
  1127.          if use_browser then
  1128.            current_module^.flags:= current_module^.flags or uf_uses_browser;
  1129. {$endif UseBrowser}
  1130.          if target_info.endian=en_big_endian then
  1131.            current_module^.flags:=current_module^.flags or uf_big_endian;
  1132.          unitheader[9]:=char(current_module^.flags);
  1133.          ppufile.write_data(unitheader,sizeof(unitheader));
  1134.  
  1135.          ppufile.clear_crc;
  1136.          ppufile.do_crc:=true;
  1137.          unit_symtable^.writeasunit;
  1138.          ppufile.flush;
  1139.          ppufile.do_crc:=false;
  1140.  
  1141. {$ifdef UseBrowser}
  1142.          { write all new references to old unit elements }
  1143.          pus:=punitsymtable(unit_symtable^.next);
  1144.          if use_browser then
  1145.          while assigned(pus) do
  1146.            begin
  1147.               if pus^.symtabletype = unitsymtable then
  1148.                 pus^.write_external_references;
  1149.               pus:=punitsymtable(pus^.next);
  1150.            end;
  1151. {$endif UseBrowser}
  1152.  
  1153.          { writes the checksum }
  1154.          ppufile.seek(10);
  1155.          current_module^.crc:=ppufile.getcrc;
  1156.          ppufile.write_data(current_module^.crc,4);
  1157.          ppufile.flush;
  1158.  
  1159.          ppufile.done;
  1160.       end;
  1161.  
  1162.  
  1163.     function readbyte : byte;
  1164.  
  1165.       var
  1166.          count : longint;
  1167.          b : byte;
  1168.  
  1169.       begin
  1170.          current_module^.ppufile^.read_data(b,sizeof(byte),count);
  1171.          readbyte:=b;
  1172.          if count<>1 then
  1173.            Message(unit_f_ppu_read_error);
  1174.       end;
  1175.  
  1176.     function readword : word;
  1177.  
  1178.       var
  1179.          count : longint;
  1180.          w : word;
  1181.  
  1182.       begin
  1183.          current_module^.ppufile^.read_data(w,sizeof(word),count);
  1184. {$IFDEF BIG_ENDIAN}
  1185.          w:=swap(w);
  1186. {$ENDIF}
  1187.          readword:=w;
  1188.          if count<>sizeof(word) then
  1189.            Message(unit_f_ppu_read_error);
  1190.       end;
  1191.  
  1192.     function readlong : longint;
  1193.  
  1194.       var
  1195.          count,l : longint;
  1196.          w1, w2  : word;
  1197.  
  1198.       begin
  1199.          current_module^.ppufile^.read_data(l,sizeof(longint),count);
  1200. {$ifdef BIG_ENDIAN}
  1201.          w1:=l and $ffff;
  1202.          w2:=l shr 16;
  1203.          l:=swap(w2)+(longint(swap(w1)) shl 16);
  1204. {$endif}
  1205.          readlong:=l;
  1206.          if count<>sizeof(longint) then
  1207.            Message(unit_f_ppu_read_error);
  1208.       end;
  1209.  
  1210.     function readdouble : double;
  1211.  
  1212.       var
  1213.          count : longint;
  1214.          d : double;
  1215.  
  1216.       begin
  1217.          current_module^.ppufile^.read_data(d,sizeof(double),count);
  1218.          readdouble:=d;
  1219.          if count<>sizeof(double) then
  1220.            Message(unit_f_ppu_read_error);
  1221.       end;
  1222.  
  1223.     function readstring : string;
  1224.  
  1225.       var
  1226.          s : string;
  1227.          count : longint;
  1228.  
  1229.       begin
  1230.          s[0]:=char(readbyte);
  1231.          current_module^.ppufile^.read_data(s[1],ord(s[0]),count);
  1232.          if count<>ord(s[0]) then
  1233.            Message(unit_f_ppu_read_error);
  1234.          readstring:=s;
  1235.       end;
  1236.  
  1237. {***SETCONST}
  1238.     procedure readset(var s);   {You cannot pass an array [0..31] of byte.}
  1239.  
  1240.     var count:longint;
  1241.  
  1242.       begin
  1243.          current_module^.ppufile^.read_data(s,32,count);
  1244.          if count<>32 then
  1245.            Message(unit_f_ppu_read_error);
  1246.       end;
  1247. {***}
  1248.  
  1249.     function readdefref : pdef;
  1250.  
  1251.       var
  1252.          hd : pdef;
  1253.  
  1254.       begin
  1255.          longint(hd):=readword;
  1256.          longint(hd):=longint(hd) or (longint(readword) shl 16);
  1257.          readdefref:=hd;
  1258.       end;
  1259.  
  1260.     procedure resolvedef(var d : pdef);
  1261.  
  1262.       begin
  1263.          if longint(d)=$ffffffff then
  1264.            d:=nil
  1265.          else
  1266.            begin
  1267.               if (longint(d) and $ffff)=$ffff then
  1268.                 d:=aktrecordsymtable^.getdefnr(longint(d) shr 16)
  1269.               else
  1270.                 d:=psymtable(current_module^.map^[longint(d) and $ffff])^.getdefnr(longint(d) shr 16);
  1271.            end;
  1272.       end;
  1273.  
  1274. {$ifdef UseBrowser}
  1275.     function readsymref : psym;
  1276.  
  1277.       var
  1278.          hd : psym;
  1279.  
  1280.       begin
  1281.          longint(hd):=readword;
  1282.          longint(hd):=longint(hd) or (longint(readword) shl 16);
  1283.          readsymref:=hd;
  1284.       end;
  1285.  
  1286.     procedure resolvesym(var d : psym);
  1287.  
  1288.       begin
  1289.          if longint(d)=$ffffffff then
  1290.            d:=nil
  1291.          else
  1292.            begin
  1293.               if (longint(d) and $ffff)=$ffff then
  1294.                 d:=aktrecordsymtable^.getsymnr(longint(d) shr 16)
  1295.               else
  1296.                 d:=psymtable(current_module^.map^[longint(d) and $ffff])^.getsymnr(longint(d) shr 16);
  1297.            end;
  1298.       end;
  1299. {$endif UseBrowser}
  1300.  
  1301. {$I+}
  1302.     procedure getsym(const s : stringid;notfounderror : boolean);
  1303.  
  1304.       begin
  1305.          srsymtable:=symtablestack;
  1306.          while assigned(srsymtable) do
  1307.            begin
  1308.               srsym:=srsymtable^.search(s);
  1309.               if assigned(srsym) then exit
  1310.               else srsymtable:=srsymtable^.next;
  1311.            end;
  1312.          if forwardsallowed then
  1313.            begin
  1314.               srsymtable:=symtablestack;
  1315.               srsym:=new(ptypesym,init(s,nil));
  1316.               srsym^.properties:=sp_forwarddef;
  1317.               srsymtable^.insert(srsym);
  1318.            end
  1319.          else if notfounderror then
  1320.            begin
  1321.               Message1(sym_e_id_not_found,s);
  1322.               srsym:=generrorsym;
  1323.            end
  1324.          else srsym:=nil;
  1325.       end;
  1326.  
  1327.     function search_a_symtable(const symbol:string;symtabletype:tsymtabletype):Psym;
  1328.  
  1329.     {Search for a symbol in a specified symbol table. Returns nil if
  1330.      the symtable is not found, and also if the symbol cannot be found
  1331.      in the desired symtable.}
  1332.  
  1333.     var hsymtab:Psymtable;
  1334.         res:Psym;
  1335.  
  1336.     begin
  1337.         res:=nil;
  1338.         hsymtab:=symtablestack;
  1339.         while (hsymtab<>nil) and (hsymtab^.symtabletype<>symtabletype) do
  1340.             hsymtab:=hsymtab^.next;
  1341.         if hsymtab<>nil then
  1342.             {We found the desired symtable. Now check if the symbol we
  1343.              search for is defined in it.}
  1344.             res:=hsymtab^.search(symbol);
  1345.         search_a_symtable:=res;
  1346.     end;
  1347.  
  1348.     procedure getsymonlyin(p : psymtable;const s : stringid);
  1349.  
  1350.       begin
  1351.          { the caller have to take care if srsym=nil (FK) }
  1352.          srsym:=nil;
  1353.          if assigned(p) then
  1354.            begin
  1355.               srsymtable:=p;
  1356.               srsym:=srsymtable^.search(s);
  1357.               if assigned(srsym) then
  1358.                 exit
  1359.               else
  1360.                Message1(sym_e_id_not_found,s);
  1361.            end;
  1362.       end;
  1363.  
  1364.     procedure dellexlevel;
  1365.  
  1366.       var
  1367.          p : psymtable;
  1368.  
  1369.       begin
  1370.          p:=symtablestack;
  1371.          symtablestack:=p^.next;
  1372.  
  1373.          { symbol tables of unit interfaces are never disposed }
  1374.          { this is handle by the unit unitm                    }
  1375.          if ((p^.symtabletype<>unitsymtable) and
  1376.            (p^.symtabletype<>globalsymtable)) or
  1377.            dispose_global then
  1378.            dispose(p,done);
  1379.       end;
  1380.  
  1381. {$ifdef DEBUG}
  1382.     procedure test_symtablestack;
  1383.       var
  1384.          p : psymtable;
  1385.          i : longint;
  1386.       begin
  1387.          p:=symtablestack;
  1388.          i:=0;
  1389.          while assigned(p) do
  1390.            begin
  1391.               inc(i);
  1392.               p:=p^.next;
  1393.               if i>500 then
  1394.                Message(sym_f_internal_error_in_symtablestack);
  1395.            end;
  1396.       end;
  1397. {$endif DEBUG}
  1398.  
  1399.     constructor tprocsym.init(const n : string);
  1400.  
  1401.       begin
  1402.          tsym.init(n);
  1403.          typ:=procsym;
  1404.          definition:=nil;
  1405.          owner:=nil;
  1406. {$ifdef GDB}
  1407.          is_global := false;
  1408. {$endif GDB}
  1409.       end;
  1410.  
  1411.     constructor tprocsym.load;
  1412.  
  1413.       begin
  1414.          tsym.load;
  1415.          typ:=procsym;
  1416.          definition:=pprocdef(readdefref);
  1417. {$ifdef GDB}
  1418.          is_global := false;
  1419. {$endif GDB}
  1420.       end;
  1421.  
  1422.     destructor tprocsym.done;
  1423.  
  1424.       begin
  1425.          check_forward;
  1426.          tsym.done;
  1427.       end;
  1428.  
  1429.     function tprocsym.mangledname : string;
  1430.  
  1431.       begin
  1432.          mangledname:=definition^.mangledname;
  1433.       end;
  1434.  
  1435.     function demangledparas(s : string) : string;
  1436.  
  1437.       var
  1438.          r : string;
  1439.          l : longint;
  1440.  
  1441.       begin
  1442.          demangledparas:='';
  1443.          r:=',';
  1444.          { delete leading $$'s }
  1445.          l:=pos('$$',s);
  1446.          while l<>0 do
  1447.            begin
  1448.               delete(s,1,l+1);
  1449.               l:=pos('$$',s);
  1450.            end;
  1451.          l:=pos('$',s);
  1452.          if l=0 then
  1453.            exit;
  1454.          delete(s,1,l);
  1455.          l:=pos('$',s);
  1456.          if l=0 then
  1457.            l:=length(s)+1;
  1458.          while s<>'' do
  1459.            begin
  1460.               r:=r+copy(s,1,l-1)+',';
  1461.               delete(s,1,l);
  1462.            end;
  1463.          delete(r,1,1);
  1464.          delete(r,length(r),1);
  1465.          demangledparas:=r;
  1466.       end;
  1467.  
  1468.     procedure tprocsym.check_forward;
  1469.  
  1470.       var
  1471.          pd : pprocdef;
  1472.  
  1473.       begin
  1474.          pd:=definition;
  1475.          while assigned(pd) do
  1476.            begin
  1477.               if pd^.forwarddef then
  1478.                 begin
  1479. {$ifdef GDB}
  1480.                    if assigned(pd^._class) then
  1481.                     Message1(sym_e_forward_not_resolved,pd^._class^.name^+'.'+name+'('+demangledparas(pd^.mangledname)+')')
  1482.                      else
  1483. {$endif GDB}
  1484.                     Message1(sym_e_forward_not_resolved,name+'('+demangledparas(pd^.mangledname)+')')
  1485.                 end;
  1486.               pd:=pd^.nextoverloaded;
  1487.            end;
  1488.       end;
  1489.  
  1490.     procedure tprocsym.deref;
  1491.       var t : ttoken;
  1492.  
  1493.       begin
  1494.          resolvedef(pdef(definition));
  1495.          for t:=PLUS to last_overloaded do
  1496.            if (overloaded_operators[t]=nil) and
  1497.               (name=overloaded_names[t]) then
  1498.               overloaded_operators[t]:=@self;
  1499.       end;
  1500.  
  1501.     constructor tprogramsym.init(const n : string);
  1502.  
  1503.       begin
  1504.          tsym.init(n);
  1505.          typ:=programsym;
  1506.       end;
  1507.  
  1508.     constructor tsymtable.init(t : tsymtabletype);
  1509.  
  1510.       begin
  1511.          symtabletype:=t;
  1512.          symtablelevel:=0;
  1513.          wurzel:=nil;
  1514.          defowner:=nil;
  1515.          unitid:=0;
  1516.          next:=nil;
  1517.          name:=nil;
  1518.          call_offset:=0;
  1519.          if symtabletype=objectsymtable then
  1520.            datasize:=4
  1521.          else
  1522.            datasize:=0;
  1523.          wurzeldef:=nil;
  1524.          hasharray:=nil;
  1525.       end;
  1526.  
  1527.     constructor tunitsymtable.init(t : tsymtabletype; const n : string);
  1528.  
  1529.       var
  1530.          w : word;
  1531.  
  1532.       begin
  1533.          tsymtable.init(t);
  1534.          name:=stringdup(n);
  1535.          unitsym:=nil;
  1536. {$ifdef GDB}
  1537.          if t = globalsymtable then
  1538.            begin
  1539.               prev_dbx_counter := dbx_counter;
  1540.               dbx_counter := @dbx_count;
  1541.            end;
  1542.          dbx_count := 0;
  1543.          unitid:=0;
  1544. {$endif GDB}
  1545.          new(hasharray);
  1546.          for w:=0 to hasharraysize-1 do
  1547.            hasharray^[w]:=nil;
  1548.          is_stab_written:=false;
  1549. {$ifdef GDB}
  1550.         if use_dbx then
  1551.           begin
  1552.              if (symtabletype=globalsymtable) then
  1553.                pglobaltypecount := @unittypecount;
  1554.              debuglist^.concat(new(pai_stabs,init(strpnew('"'+name^+'",'
  1555.                   +tostr(N_BINCL)+',0,0,0'))));
  1556.              unitid:=current_module^.unitcount;
  1557.              inc(current_module^.unitcount);
  1558.              debuglist^.concat(new(pai_direct,init(strpnew('# Global '+name^+' has index '+
  1559.                   +tostr(unitid)))));
  1560.           end;
  1561. {$endif GDB}
  1562.       end;
  1563.  
  1564.     procedure derefsym(p : psym);
  1565.  
  1566.       begin
  1567.          p^.deref;
  1568.       end;
  1569.  
  1570.     procedure derefsymsdelayed(p : psym);
  1571.  
  1572.       begin
  1573.          if p^.typ in [absolutesym,propertysym] then
  1574.            p^.deref;
  1575.       end;
  1576.  
  1577.     constructor tsymtable.load;
  1578.  
  1579.       var
  1580.          hp : pdef;
  1581.          b : byte;
  1582.          counter : word;
  1583.          sym : psym;
  1584.          ofile : string;
  1585.          ii:longint;
  1586.  
  1587.       begin
  1588.          current_module^.map^[0]:=@self;
  1589.  
  1590.          symtabletype:=unitsymtable;
  1591.          symtablelevel:=0;
  1592.  
  1593.          { unused for units }
  1594.          call_offset:=0;
  1595.  
  1596.          { reset hash array }
  1597.          new(hasharray);
  1598.          for counter:=0 to hasharraysize-1 do
  1599.             hasharray^[counter]:=nil;
  1600.  
  1601.          datasize:=0;
  1602.          wurzel:=nil;
  1603.          next:=nil;
  1604.          wurzeldef:=nil;
  1605.          defowner:=nil;
  1606.  
  1607.          unitid:=0;
  1608.          defowner:=nil;
  1609.  
  1610.          { read the definitions }
  1611.          counter:=0;
  1612.          repeat
  1613.            b:=readbyte;
  1614.            case b of
  1615.               ibpointerdef : hp:=new(ppointerdef,load);
  1616.               ibarraydef : hp:=new(parraydef,load);
  1617.               iborddef : hp:=new(porddef,load);
  1618.               ibfloatdef : hp:=new(pfloatdef,load);
  1619.               ibprocdef : hp:=new(pprocdef,load);
  1620.               ibstringdef : hp:=new(pstringdef,load);
  1621. {$ifdef UseLongString}
  1622.               iblongstringdef : hp:=new(pstringdef,longload);
  1623. {$endif UseLongString}
  1624. {$ifdef UseAnsiString}
  1625.               ibansistringdef : hp:=new(pstringdef,ansiload);
  1626. {$endif UseAnsiString}
  1627.               ibrecorddef : hp:=new(precdef,load);
  1628.               ibobjectdef : begin
  1629.                                hp:=new(pobjectdef,load);
  1630.                                { defines the VMT external                }
  1631.                                { owner isn't set in the constructor load }
  1632.                                { externals^.concat(new(pai_external,init('VMT_'+name^+'$_'+pobjectdef(hp)^.name^))); }
  1633.                             end;
  1634.               ibfiledef : hp:=new(pfiledef,load);
  1635.               ibformaldef : hp:=new(pformaldef,load);
  1636.               ibenumdef : hp:=new(penumdef,load);
  1637.               ibclassrefdef : hp:=new(pclassrefdef,load);
  1638.               { ibinitunit : usedunits^.insert(readstring); }
  1639.               iblibraries : begin
  1640.                               ofile:=readstring;
  1641.                               Linker.AddLibraryFile(ofile);
  1642.                               current_module^.LinkLibFiles.Insert(ofile);
  1643.                             end;
  1644.               iblinkofile : begin
  1645.                                ofile:=readstring;
  1646.                                if (current_module^.ppufile^.path<>nil) and
  1647.                                  not path_absolute(ofile) then
  1648.                                  Linker.AddObjectFile(current_module^.ppufile^.path^+ofile)
  1649.                                else
  1650.                                  Linker.AddObjectFile(ofile);
  1651.                             end;
  1652.               ibsetdef : hp:=new(psetdef,load);
  1653.               ibprocvardef : hp:=new(pprocvardef,load);
  1654.               ibend : break;
  1655.               else Message1(unit_f_ppu_invalid_entry,tostr(b));
  1656.            end;
  1657.  
  1658.            if not (b in [ibloadunit,ibinitunit,iblinkofile,iblibraries]) then
  1659.              begin
  1660.                 { each definition get a number }
  1661.                 hp^.number:=counter;
  1662.                 inc(counter);
  1663.  
  1664.                 hp^.next:=wurzeldef;
  1665.                 wurzeldef:=hp;
  1666.              end;
  1667.          until false;
  1668.  
  1669.          { solve the references of the symbols }
  1670.          hp:=wurzeldef;
  1671.  
  1672.          { for each definition }
  1673.          while assigned(hp) do
  1674.            begin
  1675.               hp^.deref;
  1676.  
  1677.               { insert also the owner }
  1678.               hp^.owner:=@self;
  1679.  
  1680.               hp:=hp^.next;
  1681.            end;
  1682.  
  1683.          { read the symbols }
  1684.          repeat
  1685.            b:=readbyte;
  1686.            case b of
  1687.               ibtypesym : sym:=new(ptypesym,load);
  1688.               ibprocsym : sym:=new(pprocsym,load);
  1689.               ibconstsym : sym:=new(pconstsym,load);
  1690.               ibvarsym : sym:=new(pvarsym,load);
  1691.               ibabsolutesym : sym:=new(pabsolutesym,load);
  1692.               ibaufzaehlsym : sym:=new(penumsym,load);
  1693.               ibtypedconstsym : sym:=new(ptypedconstsym,load);
  1694.               ibpropertysym : sym:=new(ppropertysym,load);
  1695.               ibend : break;
  1696.               else Message1(unit_f_ppu_invalid_entry,tostr(b));
  1697.            end;
  1698.            { don't deref absolute symbols there, because it's possible   }
  1699.            { that the var sym which the absolute sym refers, isn't       }
  1700.            { loaded                                                      }
  1701.            { but syms must be derefered to determine the definition      }
  1702.            { because must know the varsym size when inserting the symbol }
  1703.            if not(b in [ibabsolutesym,ibpropertysym]) then
  1704.              sym^.deref;
  1705.            insert(sym);
  1706.          until false;
  1707. {$ifdef tp}
  1708.          foreach(derefsymsdelayed);
  1709. {$else}
  1710.          foreach(@derefsymsdelayed);
  1711. {$endif}
  1712.          { symbol numbering for references }
  1713. {$ifdef UseBrowser}
  1714.          number_symbols;
  1715. {$endif UseBrowser}
  1716.  
  1717.       end;
  1718.  
  1719.     constructor tunitsymtable.load(const n : string);
  1720.  
  1721.       var storeGlobalTypeCount : pword;
  1722.           b : byte;
  1723.       begin
  1724.          name:=stringdup(n);
  1725.          unitsym:=nil;
  1726.          unitid:=0;
  1727.          dbx_count := 0;
  1728.          if (current_module^.flags and uf_uses_dbx)<>0 then
  1729.            begin
  1730.               storeGlobalTypeCount:=PGlobalTypeCount;
  1731.               PglobalTypeCount:=@UnitTypeCount;
  1732.            end;
  1733.          inherited load;
  1734.          if (current_module^.flags and uf_uses_dbx)<>0 then
  1735.            begin
  1736.               b := readbyte;
  1737.               if b <> ibdbxcount then
  1738.                Message(unit_f_ppu_dbx_count_problem)
  1739.               else
  1740.                dbx_count := readlong;
  1741.               dbx_count_ok := true;
  1742.               b := readbyte;
  1743.               if b <> ibend then
  1744.                Message1(unit_f_ppu_invalid_entry,tostr(b));
  1745.               PGlobalTypeCount:=storeGlobalTypeCount;
  1746.            end;
  1747.          is_stab_written:=false;
  1748.       end;
  1749.  
  1750.     constructor tsymtable.loadasstruct(typ : tsymtabletype);
  1751.  
  1752.       var
  1753.          hp : pdef;
  1754.          b : byte;
  1755.          counter : word;
  1756.          sym : psym;
  1757.  
  1758.       begin
  1759.          symtabletype:=typ;
  1760.          hasharray:=nil;
  1761.          aktrecordsymtable:=@self;
  1762.          name:=nil;
  1763.          if symtabletype=objectsymtable then
  1764.            datasize:=4
  1765.          else
  1766.            datasize:=0;
  1767.          { isn't used there }
  1768.          call_offset := 0;
  1769.          wurzel:=nil;
  1770.          next:=nil;
  1771.          wurzeldef:=nil;
  1772.          { also unused }
  1773.          unitid:=0;
  1774.  
  1775.          { read definitions }
  1776.          counter:=0;
  1777.          repeat
  1778.            b:=readbyte;
  1779.            case b of
  1780.               ibpointerdef : hp:=new(ppointerdef,load);
  1781.               ibarraydef : hp:=new(parraydef,load);
  1782.               iborddef : hp:=new(porddef,load);
  1783.               ibfloatdef : hp:=new(pfloatdef,load);
  1784.               ibprocdef : hp:=new(pprocdef,load);
  1785.               ibstringdef : hp:=new(pstringdef,load);
  1786.               ibrecorddef : hp:=new(precdef,load);
  1787.               ibobjectdef : hp:=new(pobjectdef,load);
  1788.               ibenumdef : hp:=new(penumdef,load);
  1789.               ibsetdef : hp:=new(psetdef,load);
  1790.               ibprocvardef : hp:=new(pprocvardef,load);
  1791.               ibfiledef : hp:=new(pfiledef,load);
  1792.               ibclassrefdef : hp:=new(pclassrefdef,load);
  1793.               ibformaldef : hp:=new(pformaldef,load);
  1794.               ibend : break;
  1795.               else Message1(unit_f_ppu_invalid_entry,tostr(b));
  1796.            end;
  1797.  
  1798.            { each def gets a number }
  1799.            hp^.number:=counter;
  1800.            inc(counter);
  1801.            hp^.next:=wurzeldef;
  1802.            wurzeldef:=hp;
  1803.          until false;
  1804.          { the references are solve in trecdef^.deref }
  1805.          { now read the symbols                       }
  1806.          repeat
  1807.            b:=readbyte;
  1808.            case b of
  1809.               ibtypesym : sym:=new(ptypesym,load);
  1810.               ibprocsym : sym:=new(pprocsym,load);
  1811.               ibconstsym : sym:=new(pconstsym,load);
  1812.               ibvarsym : sym:=new(pvarsym,load);
  1813.               ibabsolutesym : sym:=new(pabsolutesym,load);
  1814.               ibaufzaehlsym : sym:=new(penumsym,load);
  1815.               ibtypedconstsym : sym:=new(ptypedconstsym,load);
  1816.               ibpropertysym : sym:=new(ppropertysym,load);
  1817.               ibend : break;
  1818.               else Message1(unit_f_ppu_invalid_entry,tostr(b));
  1819.            end;
  1820.            insert(sym);
  1821.          until false;
  1822.       end;
  1823.  
  1824.     destructor tsymtable.done;
  1825.  
  1826.       var
  1827.          hp : pdef;
  1828. {$ifdef GDB}
  1829.          last : pdef;
  1830. {$endif GDB}
  1831.       begin
  1832.          { erst die Eintr„ge loeschen, da procsym's noch ihre Definitionen }
  1833.          { auf unaufgel”ste "forwards" ueberpruefen                        }
  1834.          clear;
  1835. {$ifdef GDB}
  1836.          stringdispose(name);
  1837. {$endif GDB}
  1838.          hp:=wurzeldef;
  1839. {$ifdef GDB}
  1840.          last := Nil;
  1841. {$endif GDB}
  1842.          while assigned(hp) do
  1843.            begin
  1844. {$ifdef GDB}
  1845.               if hp^.owner=@self then
  1846.                 begin
  1847.                 if assigned(last) then last^.next := hp^.next;
  1848. {$endif GDB}
  1849.               wurzeldef:=hp^.next;
  1850.               dispose(hp,done);
  1851. {$ifdef GDB}
  1852.                 end else
  1853.                 begin
  1854.                 last := hp;
  1855.                 wurzeldef:=hp^.next;
  1856.                 end;
  1857. {$endif GDB}
  1858.               hp:=wurzeldef;
  1859.            end;
  1860.  
  1861.       end;
  1862.  
  1863.    function tsymtable.getnewtypecount : word;
  1864.       begin
  1865.          getnewtypecount:=pglobaltypecount^;
  1866.          inc(pglobaltypecount^);
  1867.       end;
  1868.  
  1869.    function tunitsymtable.getnewtypecount : word;
  1870.  
  1871.       begin
  1872.          if symtabletype = staticsymtable then
  1873.            getnewtypecount:=tsymtable.getnewtypecount
  1874.          else
  1875.            begin
  1876.               getnewtypecount:=unittypecount;
  1877.               inc(unittypecount);
  1878.            end;
  1879.       end;
  1880.  
  1881.     procedure check_procsym_forward(sym : psym);
  1882.  
  1883.       begin
  1884.          if sym^.typ=procsym then
  1885.            pprocsym(sym)^.check_forward
  1886.          { check also object method table             }
  1887.          { we needn't to test the def list            }
  1888.          { because each object has to have a type sym }
  1889.          else if (sym^.typ=typesym) and
  1890.            (ptypesym(sym)^.definition^.deftype=objectdef) then
  1891.            pobjectdef(ptypesym(sym)^.definition)^.check_forwards;
  1892.       end;
  1893.  
  1894.     { checks, if all procsyms }
  1895.     { and methods are defined }
  1896.     procedure tsymtable.check_forwards;
  1897.  
  1898.       begin
  1899. {$ifdef tp}
  1900.          foreach(check_procsym_forward);
  1901. {$else}
  1902.          foreach(@check_procsym_forward);
  1903. {$endif}
  1904.       end;
  1905.  
  1906. {$ifdef UseBrowser }
  1907.     procedure add_external_ref(sym : psym);
  1908.  
  1909.       begin
  1910.          sym^.write_external_references;
  1911.       end;
  1912.  
  1913.     { writes all references to elements in other units }
  1914.     procedure tsymtable.write_external_references;
  1915.  
  1916.       begin
  1917. {$ifdef tp}
  1918.          foreach(add_external_ref);
  1919. {$else}
  1920.          foreach(@add_external_ref);
  1921. {$endif}
  1922.       end;
  1923. {$endif UseBrowser }
  1924.  
  1925.     function tsymtable.getdefnr(l : word) : pdef;
  1926.  
  1927.       var
  1928.          hp : pdef;
  1929.  
  1930.       begin
  1931.          hp:=wurzeldef;
  1932.          while (assigned(hp)) and (hp^.number<>l) do
  1933.            hp:=hp^.next;
  1934.          getdefnr:=hp;
  1935.       end;
  1936.  
  1937.     procedure tsymtable.registerdef(p : pdef);
  1938.  
  1939.       begin
  1940.          p^.next:=wurzeldef;
  1941.          wurzeldef:=p;
  1942.          p^.owner:=@self;
  1943.       end;
  1944.  
  1945.     procedure tsymtable.clear;
  1946.  
  1947.       var
  1948.          w : integer;
  1949.  
  1950.       begin
  1951.          { remove no entry from a withsymtable as it is only a pointer to the
  1952.          recorddef  or objectdef symtable }
  1953.          if symtabletype=withsymtable then exit;
  1954.          { remove all entry from a symbol table }
  1955.          if assigned(wurzel) then
  1956.            dispose(wurzel,done);
  1957.          if assigned(hasharray) then
  1958.            begin
  1959.               for w:=0 to hasharraysize-1 do
  1960.                 if assigned(hasharray^[w]) then
  1961.                   dispose(hasharray^[w],done);
  1962.               dispose(hasharray);
  1963.            end;
  1964.       end;
  1965.  
  1966. {$ifdef UseBrowser}
  1967.     function tsymtable.getsymnr(l : word) : psym;
  1968.  
  1969.       var
  1970.          hp : psym;
  1971.          i :word;
  1972.  
  1973.       begin
  1974.           getsymnr:=nil;
  1975.           if assigned(hasharray) then
  1976.             begin
  1977.                hp:=nil;
  1978.                for i:=0 to hasharraysize do
  1979.                  if hasharray^[i]^.indexnb>=l then
  1980.                    begin
  1981.                       hp:=hasharray^[i];
  1982.                       break;
  1983.                    end;
  1984.             end
  1985.           else
  1986.             hp:=wurzel;
  1987.           while assigned(hp) do
  1988.             begin
  1989.                if hp^.indexnb<l then
  1990.                  hp:=hp^.right
  1991.                else
  1992.                if hp^.indexnb>l then
  1993.                  hp:=hp^.left
  1994.                else
  1995.                  begin
  1996.                     getsymnr:=hp;
  1997.                     exit;
  1998.                  end;
  1999.             end;
  2000.       end;
  2001.  
  2002.       procedure tsymtable.number_symbols;
  2003.         var index,i : longint;
  2004.  
  2005.         procedure numbersym(var osym : psym);
  2006.  
  2007.           begin
  2008.              if osym=nil then exit;
  2009.              numbersym(osym^.left);
  2010.              osym^.indexnb:=index;
  2011.              inc(index);
  2012.              numbersym(osym^.right);
  2013.           end;
  2014.  
  2015.         begin
  2016.            index:=1;
  2017.            if assigned(hasharray) then
  2018.              for i:=0 to hasharraysize-1 do
  2019.              numbersym(hasharray^[i])
  2020.            else
  2021.              numbersym(wurzel);
  2022.         end;
  2023. {$endif UseBrowser}
  2024.  
  2025. {$ifdef CHAINPROCSYMS}
  2026.     procedure chainprocsym(p : psym);forward;
  2027. {$endif CHAINPROCSYMS}
  2028.  
  2029.     function getspeedvalue(const s : string) : longint;
  2030.  
  2031.       var
  2032.          l : longint;
  2033.          w : word;
  2034.  
  2035.       begin
  2036.          l:=0;
  2037.          for w:=1 to length(s) do
  2038.            l:=l+ord(s[w]);
  2039.          getspeedvalue:=l;
  2040.       end;
  2041.  
  2042.     procedure tsymtable.insert(sym : psym);
  2043. {$ifdef UseBrowser}
  2044.       var  ref : pref;
  2045. {$endif UseBrowser}
  2046.  
  2047.       procedure _insert(var osym : psym);
  2048.  
  2049.       {To prevent TP from allocating temp space for temp strings, we allocate
  2050.        some temp strings manually. We can use two temp strings, plus a third
  2051.        one that TP adds, where TP alone needs five temp strings!. Storing
  2052.        these on the heap saves even more, totally 1016 bytes per recursion!}
  2053.  
  2054.       var   s1,s2:^string;
  2055.  
  2056.         begin
  2057.            if osym=nil then
  2058.              osym:=sym
  2059.            { speedvalue is used, to allow a fast insert }
  2060.            else if osym^.speedvalue>sym^.speedvalue then _insert(osym^.right)
  2061.            else if osym^.speedvalue<sym^.speedvalue then _insert(osym^.left)
  2062.            else
  2063.              begin
  2064.                 new(s1);
  2065.                 new(s2);
  2066.                 s1^:=osym^.name;
  2067.                 s2^:=sym^.name;
  2068.                 if s1^>s2^ then
  2069.                     begin
  2070.                         dispose(s1);
  2071.                         dispose(s2);
  2072.                         _insert(osym^.right)
  2073.                     end
  2074.                 else if s1^<s2^ then
  2075.                     begin
  2076.                         dispose(s1);
  2077.                         dispose(s2);
  2078.                         _insert(osym^.left)
  2079.                     end
  2080.                 else
  2081.                   begin
  2082.                      dispose(s2);
  2083.                      if (osym^.typ=typesym) and (osym^.properties=sp_forwarddef) then
  2084.                        begin
  2085.                           dispose(s1);
  2086.                           if (sym^.typ<>typesym) then
  2087.                            Message(sym_f_id_already_typed);
  2088.                           {
  2089.                           if (ptypesym(sym)^.definition^.deftype<>recorddef) and
  2090.                              (ptypesym(sym)^.definition^.deftype<>objectdef) then
  2091.                              Message(sym_f_type_must_be_rec_or_class);
  2092.                           }
  2093.                           ptypesym(osym)^.definition:=ptypesym(sym)^.definition;
  2094.                           osym^.properties:=sp_public;
  2095.                           { resolve the definition right now !! }
  2096. {$ifdef UseBrowser}
  2097.                           {forward types have two defref chained
  2098.                           the first corresponding to the location
  2099.                           of  the
  2100.                              ptype = ^ttype;
  2101.                           and the second
  2102.                           to the line
  2103.                              ttype = record }
  2104.                           new(ref,init(nil));
  2105.                           ref^.nextref:=osym^.defref;
  2106.                           osym^.defref:=ref;
  2107. {$endif UseBrowser}
  2108.                           ptypesym(osym)^.forwardpointer^.definition:=ptypesym(osym)^.definition;
  2109. {$ifndef GDB}
  2110.                           dispose(sym);
  2111. {$else GDB}
  2112.                           if ptypesym(osym)^.definition^.sym = ptypesym(sym) then
  2113.                             ptypesym(osym)^.definition^.sym := ptypesym(osym);
  2114.                          ptypesym(osym)^.isusedinstab := true;
  2115.                          if (cs_debuginfo in aktswitches) and assigned(debuglist) then
  2116.                             osym^.concatstabto(debuglist);
  2117.                           { don't do a done on sym
  2118.                           because it also disposes left and right !!}
  2119.                           dispose(sym);
  2120. {$endif GDB}
  2121.                        end
  2122.                      else
  2123.                        begin
  2124.                           dispose(s1);
  2125.                           Message1(sym_e_duplicate_id,sym^.name);
  2126.                        end;
  2127.                   end;
  2128.              end;
  2129.       end;
  2130.  
  2131.       var
  2132.          l : longint;
  2133.          hp : psymtable;
  2134.          hsym : psym;
  2135.  
  2136.       begin
  2137.          { bei Symbolen fr Variablen die Adresse eintragen, }
  2138.          { und Gr”áe der Symboltabellendaten berechnen       }
  2139. {$ifdef GDB}
  2140.          sym^.owner:=@self;
  2141. {$endif GDB}
  2142. {$ifdef CHAINPROCSYMS}
  2143.          { set the nextprocsym field }
  2144.          if sym^.typ=procsym then
  2145.            chainprocsym(sym);
  2146. {$endif CHAINPROCSYMS}
  2147.          { handle static variables of objects especially }
  2148.          if read_member and (symtabletype=objectsymtable) and
  2149.             (sym^.typ=varsym) and
  2150.             ((pvarsym(sym)^.properties and sp_static)<>0) then
  2151.            begin
  2152.               { the data filed is generated in parser.pas
  2153.                 with a tobject_FIELDNAME variable }
  2154.               { this symbol can't be loaded to a register }
  2155.               pvarsym(sym)^.regable:=false;
  2156.            end
  2157.          else if (sym^.typ=varsym) and not(read_member) then
  2158.            begin
  2159.               { made problems with parameters etc. ! (FK) }
  2160.  
  2161.               {  check for instance of an abstract object or class }
  2162.               {
  2163.               if (pvarsym(sym)^.definition^.deftype=objectdef) and
  2164.                 ((pobjectdef(pvarsym(sym)^.definition)^.options and oois_abstract)<>0) then
  2165.                 Message(sym_e_no_instance_of_abstract_object);
  2166.               }
  2167.  
  2168.  
  2169.               { bei einer lokalen Symboltabelle erst! erh”hen, da der }
  2170.               { Wert in codegen.secondload dann mit minus verwendet   }
  2171.               { wird                                                  }
  2172.               l:=pvarsym(sym)^.getsize;
  2173.               if symtabletype=localsymtable then
  2174.                 begin
  2175.                    pvarsym(sym)^.is_valid := 0;
  2176.                    inc(datasize,l);
  2177. {$ifdef m68k}
  2178.                    { word alignment required for motorola }
  2179.                    if (l=1) then
  2180.                     inc(datasize,1)
  2181.                    else
  2182. {$endif}
  2183.                    if (l>=4) and ((datasize and 3)<>0) then
  2184.                      inc(datasize,4-(datasize and 3))
  2185.                    else if (l>=2) and ((datasize and 1)<>0) then
  2186.                      inc(datasize,2-(datasize and 1));
  2187.  
  2188.                    pvarsym(sym)^.address:=datasize;
  2189.                 end
  2190.               else if symtabletype=staticsymtable then
  2191.                 begin
  2192. {$ifdef MAKELIB}
  2193.                    bsssegment^.concat(new(pai_cut,init));
  2194. {$endif MAKELIB}
  2195. {$ifdef GDB}
  2196.                    if cs_debuginfo in aktswitches then
  2197.                      begin
  2198.                         sym^.concatstabto(bsssegment);
  2199.                      end;
  2200. {$endif GDB}
  2201. {$ifndef MAKELIB}
  2202.                    bsssegment^.concat(new(pai_datablock,init(sym^.mangledname,l)));
  2203. {$else MAKELIB}
  2204.   { we need to change this to a global symbol }
  2205.                    bsssegment^.concat(new(pai_datablock,init_global(sym^.mangledname,l)));
  2206. {$endif MAKELIB}
  2207.                    inc(datasize,l);
  2208.  
  2209.                    { this symbol can't be loaded to a register }
  2210.                    pvarsym(sym)^.regable:=false;
  2211.                 end
  2212.               else if symtabletype=globalsymtable then
  2213.                 begin
  2214. {$ifdef MAKELIB}
  2215.                    bsssegment^.concat(new(pai_cut,init));
  2216. {$endif MAKELIB}
  2217. {$ifdef GDB}
  2218.                    if cs_debuginfo in aktswitches then
  2219.                      begin
  2220.                         sym^.concatstabto(bsssegment);
  2221.                         { this has to be added so that the debugger knows where to find
  2222.                           the global variable
  2223.                           Doesn't work !!
  2224.  
  2225.                         bsssegment^.concat(new(pai_symbol,init('_'+sym^.name))); }
  2226.                      end;
  2227. {$endif GDB}
  2228.                    bsssegment^.concat(new(pai_datablock,init_global(
  2229.                      sym^.mangledname,l)));
  2230.                    inc(datasize,l);
  2231. {$ifdef MAKELIB}
  2232.                    bsssegment^.concat(new(pai_cut,init));
  2233. {$endif MAKELIB}
  2234.  
  2235.                    { this symbol can't be loaded to a register }
  2236.                    pvarsym(sym)^.regable:=false;
  2237.                 end
  2238.               else if symtabletype in [recordsymtable,objectsymtable] then
  2239.         begin
  2240.            { align record and object fields }
  2241.            if aktpackrecords=2 then
  2242.              begin
  2243.             { align to word }
  2244.             if (l>=2) and ((datasize and 1)<>0) then
  2245.               inc(datasize);
  2246.                      end
  2247.                    else if aktpackrecords=4 then
  2248.                      begin
  2249.                         { align to dword }
  2250.                         if (l>=3) and ((datasize and 3)<>0) then
  2251.                           inc(datasize,4-(datasize and 3))
  2252.                         { or word }
  2253.                         else if (l=2) and ((datasize and 1)<>0) then
  2254.                           inc(datasize)
  2255.                      end;
  2256.                    pvarsym(sym)^.address:=datasize;
  2257.                    inc(datasize,l);
  2258.  
  2259.                    { this symbol can't be loaded to a register }
  2260.                    pvarsym(sym)^.regable:=false;
  2261.                 end
  2262.               else if symtabletype=parasymtable then
  2263.                 begin
  2264.                    pvarsym(sym)^.address:=datasize;
  2265.  
  2266.                    { intel processors don't know a byte push, }
  2267.                    { so is always a word pushed               }
  2268.                    if l=1 then
  2269.                      l:=2;
  2270.                    inc(datasize,l);
  2271.                 end
  2272.               else
  2273.                 begin
  2274.                    if (l>=4) and ((datasize and 3)<>0) then
  2275.                      inc(datasize,4-(datasize and 3))
  2276.                    else if (l>=2) and ((datasize and 1)<>0) then
  2277.                      inc(datasize,2-(datasize and 1));
  2278.                    pvarsym(sym)^.address:=datasize;
  2279.                    inc(datasize,l);
  2280.                 end;
  2281.            end
  2282.          else if sym^.typ=typedconstsym then
  2283.              begin
  2284. {$ifdef MAKELIB}
  2285.                 bsssegment^.concat(new(pai_cut,init));
  2286. {$endif MAKELIB}
  2287.                 if symtabletype=globalsymtable then
  2288.                     begin
  2289. {$ifdef GDB}
  2290.                         if cs_debuginfo in aktswitches then
  2291.                             sym^.concatstabto(datasegment);
  2292. {$endif GDB}
  2293.                         datasegment^.concat(new(pai_symbol,init_global(sym^.mangledname)));
  2294.                     end
  2295.                 else
  2296.                     if symtabletype<>unitsymtable then
  2297.                         begin
  2298. {$ifdef GDB}
  2299.                             if cs_debuginfo in aktswitches then
  2300.                                 sym^.concatstabto(datasegment);
  2301. {$endif GDB}
  2302. {$ifndef MAKELIB}
  2303.                      datasegment^.concat(new(pai_symbol,init(sym^.mangledname)));
  2304. {$else MAKELIB}
  2305.   { we need to change this to a global symbol }
  2306.   { lets use almost the same prefix than for globals but with one $ more }
  2307.                      datasegment^.concat(new(pai_symbol,init_global(sym^.mangledname)));
  2308. {$endif MAKELIB}
  2309.                   end;
  2310.              end;
  2311.          if (symtabletype=staticsymtable) or
  2312.             (symtabletype=globalsymtable) then
  2313.            begin
  2314.               hp:=symtablestack;
  2315.               while assigned(hp) do
  2316.                 begin
  2317.                    if hp^.symtabletype in
  2318.                     [staticsymtable,globalsymtable] then
  2319.                         begin
  2320.                            hsym:=hp^.search(sym^.name);
  2321.                            if (assigned(hsym)) and
  2322.                               (hsym^.properties and sp_forwarddef=0) then
  2323.                                  Message1(sym_e_duplicate_id,sym^.name);
  2324.                         end;
  2325.                       hp:=hp^.next;
  2326.                 end;
  2327.            end;
  2328.          if sym^.typ = typesym then
  2329.            if assigned(ptypesym(sym)^.definition) then
  2330.              begin
  2331.              if not assigned(ptypesym(sym)^.definition^.owner) then
  2332.               registerdef(ptypesym(sym)^.definition);
  2333. {$ifdef GDB}
  2334.              if (cs_debuginfo in aktswitches) and assigned(debuglist)
  2335.                 and (symtabletype <> unitsymtable) then
  2336.                    begin
  2337.                    ptypesym(sym)^.isusedinstab := true;
  2338.                    sym^.concatstabto(debuglist);
  2339.                    end;
  2340. {$endif GDB}
  2341.              end;
  2342. {$ifdef TEST_FUNCRET}
  2343.          if sym^.typ=funcretsym then
  2344.            begin
  2345.               { allocate space in local if ret in acc or in fpu }
  2346.               if ret_in_acc(procinfo.retdef) or (procinfo.retdef^.deftype=floatdef) then
  2347.                 begin
  2348.                    l:=pfuncretsym(sym)^.funcretdef^.size;
  2349.                    inc(datasize,l);
  2350. {$ifdef m68k}
  2351.                    { word alignment required for motorola }
  2352.                    if (l=1) then
  2353.                     inc(datasize,1)
  2354.                    else
  2355. {$endif}
  2356.                    if (l>=4) and ((datasize and 3)<>0) then
  2357.                      inc(datasize,4-(datasize and 3))
  2358.                    else if (l>=2) and ((datasize and 1)<>0) then
  2359.                      inc(datasize,2-(datasize and 1));
  2360.  
  2361.                    pfuncretsym(sym)^.address:=datasize;
  2362.                 end;
  2363.            end;
  2364. {$endif TEST_FUNCRET}
  2365.          sym^.speedvalue:=getspeedvalue(sym^.name);
  2366.          if assigned(hasharray) then
  2367.            _insert(hasharray^[sym^.speedvalue mod hasharraysize])
  2368.          else
  2369.            _insert(wurzel);
  2370.       end;
  2371.  
  2372.     procedure unitsymbolused(p : psym);
  2373.  
  2374.       begin
  2375.          if p^.typ=unitsym then
  2376.            if (punitsym(p)^.refs=0) then
  2377.              comment(V_info,'Unit '+p^.name+' is not used');
  2378.       end;
  2379.  
  2380.     procedure tsymtable.allunitsused;
  2381.  
  2382.       begin
  2383. {$ifdef tp}
  2384.          foreach(unitsymbolused);
  2385. {$else}
  2386.          foreach(@unitsymbolused);
  2387. {$endif}
  2388.       end;
  2389.  
  2390.     procedure varsymbolused(p : psym);
  2391.  
  2392.       begin
  2393.          if (p^.typ=varsym) and
  2394.             ((p^.owner^.symtabletype=parasymtable) or
  2395.             (p^.owner^.symtabletype=localsymtable) or
  2396.             (p^.owner^.symtabletype=staticsymtable))
  2397.             then
  2398.            { unused symbol should be reported only if no }
  2399.            { error is reported                           }
  2400.            { if the symbol is in a register it is used   }
  2401.            if (pvarsym(p)^.refs=0) and
  2402.               (errorcount=0) and
  2403.               (pvarsym(p)^.reg=R_NO) then
  2404.              begin
  2405.              {   if p^.owner^.symtabletype=parasymtable then
  2406.                   exterror:=strpnew(' arg '+p^.name
  2407.                     +' declared in line '+tostr(p^.line_no))
  2408.                 else
  2409.                   exterror:=strpnew(' local '+p^.name
  2410.                     +' declared in line '+tostr(p^.line_no)); }
  2411.                 Message2(sym_h_identifier_not_used,p^.name,tostr(p^.line_no));
  2412.              end;
  2413.       end;
  2414.  
  2415.     procedure tsymtable.allsymbolsused;
  2416.  
  2417.       begin
  2418. {$ifdef tp}
  2419.          foreach(varsymbolused);
  2420. {$else}
  2421.          foreach(@varsymbolused);
  2422. {$endif}
  2423.       end;
  2424.  
  2425. {$ifdef CHAINPROCSYMS}
  2426.     procedure chainprocsym(p : psym);
  2427.  
  2428.       var
  2429.          storesymtablestack : psymtable;
  2430.       begin
  2431.          if p^.typ=procsym then
  2432.            begin
  2433.               storesymtablestack:=symtablestack;
  2434.               symtablestack:=p^.owner^.next;
  2435.               while assigned(symtablestack) do
  2436.                 begin
  2437.                   { search for same procsym in other units }
  2438.                   getsym(p^.name,false);
  2439.                   if assigned(srsym) and (srsym^.typ=procsym) then
  2440.                     begin
  2441.                        pprocsym(p)^.nextprocsym:=pprocsym(srsym);
  2442.                        symtablestack:=storesymtablestack;
  2443.                        exit;
  2444.                     end
  2445.                   else if srsym=nil then
  2446.                     symtablestack:=nil
  2447.                   else
  2448.                     symtablestack:=srsymtable^.next;
  2449.                 end;
  2450.               symtablestack:=storesymtablestack;
  2451.            end;
  2452.       end;
  2453.  
  2454.     procedure tsymtable.chainprocsyms;
  2455.  
  2456.       begin
  2457. {$ifdef tp}
  2458.          foreach(chainprocsym);
  2459. {$else}
  2460.          foreach(@chainprocsym);
  2461. {$endif}
  2462.       end;
  2463. {$endif CHAINPROCSYMS}
  2464.  
  2465. {$ifdef GDB}
  2466.  
  2467.       var l : paasmoutput;
  2468.  
  2469.       procedure concatstab(p : psym);
  2470.       begin
  2471.       if p^.typ <> procsym then
  2472.         p^.concatstabto(l);
  2473.       end;
  2474.  
  2475.       procedure concattypestab(p : psym);
  2476.       begin
  2477.       if p^.typ = typesym then
  2478.         begin
  2479.         p^.isstabwritten:=false;
  2480.         p^.concatstabto(l);
  2481.         end;
  2482.       end;
  2483.  
  2484.       procedure tsymtable.concatstabto(asmlist : paasmoutput);
  2485.       begin
  2486.       l := asmlist;
  2487. {$ifdef tp}
  2488.       foreach(concatstab);
  2489. {$else}
  2490.       foreach(@concatstab);
  2491. {$endif}
  2492.       end;
  2493.  
  2494.       procedure tunitsymtable.concattypestabto(asmlist : paasmoutput);
  2495.         var prev_dbx_count : plongint;
  2496.         begin
  2497.            if is_stab_written then exit;
  2498.            if not assigned(name) then name := stringdup('Main_program');
  2499.            if symtabletype = unitsymtable then
  2500.              begin
  2501.                 unitid:=current_module^.unitcount;
  2502.                 inc(current_module^.unitcount);
  2503.              end;
  2504.            asmlist^.concat(new(pai_direct,init(strpnew('# Begin unit '+name^
  2505.                   +' has index '+tostr(unitid)))));
  2506.            if use_dbx then
  2507.              begin
  2508.                 if dbx_count_ok then
  2509.                   begin
  2510.                      asmlist^.insert(new(pai_direct,init(strpnew('# "repeated" unit '+name^
  2511.                               +' has index '+tostr(unitid)))));
  2512.                      do_count_dbx:=true;
  2513.                      asmlist^.concat(new(pai_stabs,init(strpnew('"'+name^+'",'
  2514.                        +tostr(N_EXCL)+',0,0,'+tostr(dbx_count)))));
  2515.                      exit;
  2516.                   end;
  2517.                 prev_dbx_count := dbx_counter;
  2518.                 dbx_counter := nil;
  2519.                 if symtabletype = unitsymtable then
  2520.                   asmlist^.concat(new(pai_stabs,init(strpnew('"'+name^+'",'
  2521.                     +tostr(N_BINCL)+',0,0,0'))));
  2522.                 dbx_counter := @dbx_count;
  2523.              end;
  2524.            l:=asmlist;
  2525. {$ifdef tp}
  2526.            foreach(concattypestab);
  2527. {$else}
  2528.            foreach(@concattypestab);
  2529. {$endif}
  2530.            if use_dbx then
  2531.              begin
  2532.                 dbx_counter := prev_dbx_count;
  2533.                 do_count_dbx:=true;
  2534.                 asmlist^.concat(new(pai_stabs,init(strpnew('"'+name^+'",'
  2535.                   +tostr(N_EINCL)+',0,0,0'))));
  2536.                 dbx_count_ok := true;
  2537.              end;
  2538.            asmlist^.concat(new(pai_direct,init(strpnew('# End unit '+name^
  2539.                   +' has index '+tostr(unitid)))));
  2540.            is_stab_written:=true;
  2541.         end;
  2542.  
  2543.     procedure forcestabto(asmlist : paasmoutput; pd : pdef);
  2544.     begin
  2545.     if not pd^.isstabwritten then
  2546.       begin
  2547.       if assigned(pd^.sym) and (pd^.sym^.typ=typesym) then
  2548.         pd^.sym^.isusedinstab := true;
  2549.       pd^.concatstabto(asmlist);
  2550.       end;
  2551.     end;
  2552.  
  2553. {$endif GDB}
  2554.  
  2555.     function tsymtable.search(const s : stringid) : psym;
  2556.  
  2557.       var
  2558.          hp : psym;
  2559.          speedvalue : longint;
  2560.  
  2561.       begin
  2562.          speedvalue:=getspeedvalue(s);
  2563.          if assigned(hasharray) then
  2564.            hp:=hasharray^[speedvalue mod hasharraysize]
  2565.          else
  2566.            hp:=wurzel;
  2567.          while assigned(hp) do
  2568.            begin
  2569.               if speedvalue>hp^.speedvalue then hp:=hp^.left
  2570.               else if speedvalue<hp^.speedvalue then hp:=hp^.right
  2571.               else
  2572.                 begin
  2573.                    if (hp^.name=s) then
  2574.                      begin
  2575.                         { reject non static members in static procedures }
  2576.                         if (symtabletype=objectsymtable) and
  2577.                            ((hp^.properties and sp_static)=0) and
  2578.                            assigned(aktprocsym) and
  2579.                            ((aktprocsym^.definition^.options and postaticmethod)<>0) then
  2580.                                Message(sym_e_only_static_in_static);
  2581.                         { should we allow use of private field in the whole
  2582.                         unit ? }
  2583.                         if (symtabletype=objectsymtable) and
  2584.                            (hp^.properties=sp_private) and
  2585.                            {defowner is the objectdef and the owner of the objectdef
  2586.                            is a unitsymtable, or golbalsymtable if we are compiling it !!}
  2587.                            (psymtable(defowner^.owner)^.symtabletype<>globalsymtable) and
  2588.                            (aktobjectdef<>pobjectdef(defowner)) and
  2589.                            ((aktprocsym^.definition=nil) or
  2590.                            (aktprocsym^.definition^._class<>pobjectdef(defowner))) then
  2591.                            begin
  2592.                               search:=nil;
  2593.                               exit;
  2594.                            end;
  2595.                         search:=hp;
  2596.                         if (symtabletype=unitsymtable) and
  2597.                            assigned(punitsymtable(@self)^.unitsym) then
  2598.                           inc(punitsymtable(@self)^.unitsym^.refs);
  2599. {$ifdef UseBrowser}
  2600.                         add_new_ref(hp^.lastref);
  2601.                         { for symbols that are in tables without
  2602.                         browser info }
  2603.                         if hp^.refcount=0 then
  2604.                           hp^.defref:=hp^.lastref;
  2605.                         inc(hp^.refcount);
  2606. {$endif UseBrowser}
  2607.                         exit;
  2608.                      end
  2609.                   else if s>hp^.name then hp:=hp^.left
  2610.                   else hp:=hp^.right;
  2611.                 end;
  2612.            end;
  2613.          search:=nil;
  2614.       end;
  2615.  
  2616.     procedure tsymtable.foreach(proc2call : tcallback);
  2617.  
  2618.       procedure a(p : psym);
  2619.  
  2620.         { must be preorder, because it's used by reading in }
  2621.         { a PPU file                                        }
  2622.         begin
  2623.            proc2call(p);
  2624.            if assigned(p^.left) then a(p^.left);
  2625.            if assigned(p^.right) then a(p^.right);
  2626.         end;
  2627.  
  2628.       var
  2629.          i : integer;
  2630.  
  2631.       begin
  2632.          if hasharray<>nil then
  2633.            begin
  2634.               for i:=0 to hasharraysize-1 do
  2635.                 if assigned(hasharray^[i]) then
  2636.                   a(hasharray^[i]);
  2637.            end
  2638.          else
  2639.            if assigned(wurzel) then
  2640.              a(wurzel);
  2641.       end;
  2642.  
  2643.     { write one symbol, is only used as call back procedure }
  2644.     procedure writesym(p : psym);
  2645.  
  2646.       begin
  2647.          p^.write;
  2648.       end;
  2649.  
  2650.     procedure tsymtable.number_units;
  2651.  
  2652.       var
  2653.          counter : word;
  2654.          p : psymtable;
  2655.  
  2656.      begin
  2657.          unitid:=0;
  2658.  
  2659.          { zuerst alle im Interface-Abschnitt aufgefhrten Units }
  2660.          { in die Datei schreiben und numerieren }
  2661.          p:=next;
  2662.          counter:=1;
  2663.  
  2664.          { im Implementationsteil aufgefuehrte Units ueberspringen }
  2665.          if symtabletype<>globalsymtable then
  2666.            begin
  2667.               while (p^.symtabletype<>globalsymtable) do
  2668.                 p:=p^.next;
  2669.               p:=p^.next;
  2670.            end;
  2671.          while assigned(p) do
  2672.            begin
  2673.               if p^.symtabletype=unitsymtable then
  2674.                 begin
  2675.                    p^.unitid:=counter;
  2676.                    inc(counter);
  2677.                 end;
  2678.               p:=p^.next;
  2679.            end;
  2680.  
  2681.       end;
  2682.  
  2683.     procedure tsymtable.number_defs;
  2684.  
  2685.       var
  2686.          pd : pdef;
  2687.          counter : longint;
  2688.  
  2689.       begin
  2690.          counter:=0;
  2691.          pd:=wurzeldef;
  2692.          while assigned(pd) do
  2693.            begin
  2694.               pd^.number:=counter;
  2695.               inc(counter);
  2696.               pd:=pd^.next;
  2697.            end;
  2698.       end;
  2699.  
  2700. {$ifdef GDB }
  2701.     procedure tunitsymtable.orderdefs;
  2702.       var
  2703.          first, last, nonum, pd, cur, prev, lnext : pdef;
  2704.  
  2705.       begin
  2706.          pd:=wurzeldef;
  2707.          first:=nil;
  2708.          last:=nil;
  2709.          nonum:=nil;
  2710.          while assigned(pd) do
  2711.            begin
  2712.               lnext:=pd^.next;
  2713.               if pd^.globalnb > 0 then
  2714.                 if first = nil then
  2715.                   begin
  2716.                      first:=pd;
  2717.                      last:=pd;
  2718.                      last^.next:=nil;
  2719.                   end
  2720.                 else
  2721.                   begin
  2722.                      cur:=first;
  2723.                      prev:=nil;
  2724.                      while assigned(cur) and
  2725.                            (prev <> last) and
  2726.                            (cur^.globalnb>0) and
  2727.                            (cur^.globalnb<pd^.globalnb) do
  2728.                        begin
  2729.                           prev:=cur;
  2730.                           cur:=cur^.next;
  2731.                        end;
  2732.                      if cur = first then
  2733.                        begin
  2734.                           pd^.next:=first;
  2735.                           first:=pd;
  2736.                        end
  2737.                      else
  2738.                      if prev = last then
  2739.                        begin
  2740.                           pd^.next:=nil;
  2741.                           last^.next:=pd;
  2742.                           last:=pd;
  2743.                        end
  2744.                      else
  2745.                        begin
  2746.                           pd^.next:=cur;
  2747.                           prev^.next:=pd;
  2748.                        end;
  2749.                   end
  2750.                 else  { without number }
  2751.                   begin
  2752.                      pd^.next:=nonum;
  2753.                      nonum:=pd;
  2754.                   end;
  2755.               pd:=lnext;
  2756.            end;
  2757.          if assigned(first) then
  2758.            begin
  2759.               wurzeldef:=first;
  2760.               last^.next:=nonum;
  2761.            end else
  2762.            wurzeldef:=nonum;
  2763.       end;
  2764. {$endif GDB }
  2765.  
  2766.     procedure tunitsymtable.writeasunit;
  2767.  
  2768.       var
  2769.          counter : word;
  2770.          hp : pused_unit;
  2771.          hp2 : pextfile;
  2772.          s : string;
  2773.          index : word;
  2774.  
  2775.       begin
  2776.          { second write the used source files }
  2777.          hp2:=current_module^.sourcefiles.files;
  2778.          index:=current_module^.sourcefiles.last_ref_index;
  2779.          while assigned(hp2) do
  2780.            begin
  2781.               ppufile.write_byte(ibsourcefile);
  2782.  
  2783.               { only name and extension }
  2784.               writestring(hp2^.name^+hp2^.ext^);
  2785.               { index in that order }
  2786.               hp2^.ref_index:=index;
  2787.               dec(index);
  2788.               hp2:=hp2^._next;
  2789.            end;
  2790.  
  2791.          ppufile.write_byte(ibend);
  2792.  
  2793.          unitid:=0;
  2794.  
  2795.          { each used unit gets a number }
  2796.          counter:=1;
  2797.  
  2798.          { ... and write interface units with their number and checksum }
  2799.          hp:=pused_unit(current_module^.used_units.first);
  2800.          while assigned(hp) do
  2801.            begin
  2802.               if hp^.in_interface then
  2803.                 begin
  2804.                   psymtable(hp^.u^.symtable)^.unitid:=counter;
  2805.                   inc(counter);
  2806.                   ppufile.write_byte(ibloadunit);
  2807.                   writestring(psymtable(hp^.u^.symtable)^.name^);
  2808.                   ppufile.write_long(hp^.u^.crc);
  2809.                 end;
  2810.               hp:=pused_unit(hp^.next);
  2811.            end;
  2812.  
  2813.          ppufile.write_byte(ibend);
  2814.  
  2815.          { writes the names of the units which should be init'ed
  2816.          s:=usedunits^.get;
  2817.          while s<>'' do
  2818.            begin
  2819.               writebyte(ibinitunit);
  2820.               writestring(s);
  2821.               s:=usedunits^.get;
  2822.            end;
  2823.          }
  2824.  
  2825.          { we should only write the objectfiles that come for this unit !! }
  2826.          while not current_module^.linkofiles.empty do
  2827.            begin
  2828.               ppufile.write_byte(iblinkofile);
  2829.               writestring(current_module^.linkofiles.get);
  2830.            end;
  2831.  
  2832.  
  2833.          { write any used libraries }
  2834.          while not current_module^.linklibfiles.empty do
  2835.            begin
  2836.               ppufile.write_byte(iblibraries);
  2837.               writestring(current_module^.linklibfiles.get);
  2838.            end;
  2839.  
  2840.  
  2841.          tsymtable.write;
  2842.          if use_dbx then
  2843.            begin
  2844.               ppufile.write_byte(ibdbxcount);
  2845.               ppufile.write_long(dbx_count);
  2846. {$IfDef EXTDEBUG}
  2847.               writeln('Writing dbx_count ',dbx_count,' in unit ',name^,'.ppu');
  2848. {$ENDIF EXTDEBUG}
  2849.               ppufile.write_byte(ibend);
  2850.            end;
  2851.          { ... and write implementation units with their number and checksum }
  2852.          hp:=pused_unit(current_module^.used_units.first);
  2853.          while assigned(hp) do
  2854.            begin
  2855.               if not hp^.in_interface then
  2856.                 begin
  2857.                   psymtable(hp^.u^.symtable)^.unitid:=counter;
  2858.                   inc(counter);
  2859.                   ppufile.write_byte(ibloadunit);
  2860.                   writestring(psymtable(hp^.u^.symtable)^.name^);
  2861.                   {this remains a problem : the crc is not calculted yet ! }
  2862.                   ppufile.write_long(hp^.u^.crc);
  2863.                 end;
  2864.               hp:=pused_unit(hp^.next);
  2865.            end;
  2866.  
  2867.          ppufile.write_byte(ibend);
  2868.  
  2869.       end;
  2870.  
  2871.     procedure tsymtable.writeasstruct;
  2872.  
  2873.       begin
  2874.          tsymtable.write;
  2875.       end;
  2876.  
  2877.     procedure tsymtable.write;
  2878.  
  2879.       var
  2880.          pd : pdef;
  2881.  
  2882.       begin
  2883.          { each definition get a number ... }
  2884.          number_defs;
  2885.          { ...now write the definition }
  2886.          pd:=wurzeldef;
  2887.          while assigned(pd) do
  2888.            begin
  2889.               pd^.write;
  2890.               pd:=pd^.next;
  2891.            end;
  2892.  
  2893.          { the next part are the symbols }
  2894.          ppufile.write_byte(ibend);
  2895.  
  2896.          { symbol numbering for references }
  2897. {$ifdef UseBrowser}
  2898.          number_symbols;
  2899. {$endif UseBrowser}
  2900.          { foreach is used to write all symbols }
  2901.  
  2902. {$ifdef tp}
  2903.          foreach(writesym);
  2904. {$else}
  2905.          foreach(@writesym);
  2906. {$endif}
  2907.          { end of symbols }
  2908.          ppufile.write_byte(ibend);
  2909.       end;
  2910.  
  2911. {**************************************
  2912.               "forward"-pointer
  2913.  **************************************}
  2914.  
  2915.     type
  2916.        presolvelist = ^tresolvelist;
  2917.  
  2918.        tresolvelist = record
  2919.           p : ppointerdef;
  2920.           typ : ptypesym;
  2921.           next : presolvelist;
  2922.        end;
  2923.  
  2924.     var
  2925.        swurzel : presolvelist;
  2926.  
  2927. {$ifdef GDB}
  2928.     procedure clear_forwards;
  2929.  
  2930.       var
  2931.          p : presolvelist;
  2932.  
  2933.       begin
  2934.          p:=swurzel;
  2935.          while assigned(p) do
  2936.          begin
  2937.               swurzel:=p^.next;
  2938.             dispose(p);
  2939.             p := swurzel;
  2940.          end;
  2941.       end;
  2942.  
  2943. {$endif GDB}
  2944.     procedure save_forward(ppd : ppointerdef;typesym : ptypesym);
  2945.  
  2946.       var
  2947.          p : presolvelist;
  2948.  
  2949.       begin
  2950.          new(p);
  2951.          p^.next:=swurzel;
  2952.          p^.p:=ppd;
  2953.          ppd^.defsym := typesym;
  2954.          p^.typ:=typesym;
  2955.          swurzel:=p;
  2956.       end;
  2957.  
  2958.     procedure resolve_forwards;
  2959.  
  2960.       var
  2961.          p : presolvelist;
  2962.  
  2963.       begin
  2964.          p:=swurzel;
  2965.          while p<>nil do
  2966.            begin
  2967.               swurzel:=swurzel^.next;
  2968.               p^.p^.definition:=p^.typ^.definition;
  2969.               dispose(p);
  2970.               p:=swurzel;
  2971.            end;
  2972.       end;
  2973.  
  2974.     constructor tsym.init(const n : string);
  2975.  
  2976.       begin
  2977.          left:=nil;
  2978.          right:=nil;
  2979.          setname(n);
  2980.          typ:=abstractsym;
  2981.          properties:=current_object_option;
  2982. {$ifdef GDB}
  2983.          isstabwritten := false;
  2984.          if assigned(current_module) and assigned(current_module^.current_inputfile) then
  2985.            line_no:=current_module^.current_inputfile^.line_no
  2986.          else
  2987.            line_no:=0;
  2988. {$endif GDB}
  2989. {$ifdef UseBrowser}
  2990.          defref:=nil;
  2991.          lastwritten:=nil;
  2992.          add_new_ref(defref);
  2993.          lastref:=defref;
  2994.          refcount:=1;
  2995. {$endif UseBrowser}
  2996.       end;
  2997.  
  2998.     constructor tsym.load;
  2999.  
  3000.       begin
  3001.          left:=nil;
  3002.          right:=nil;
  3003.          setname(readstring);
  3004.          typ:=abstractsym;
  3005.          if object_options then
  3006.            properties:=symprop(readbyte)
  3007.          else
  3008.            properties:=sp_public;
  3009. {$ifdef UseBrowser}
  3010.          lastref:=nil;
  3011.          defref:=nil;
  3012.          lastwritten:=nil;
  3013.          refcount:=0;
  3014.          if (current_module^.flags and uf_uses_browser)<>0 then
  3015.            { references do not change the ppu caracteristics      }
  3016.            { this only save the references to variables/functions }
  3017.            { defined in the unit what about the others            }
  3018.            load_references;
  3019. {$endif UseBrowser}
  3020. {$ifdef GDB}
  3021.          isstabwritten := false;
  3022.          line_no:=0;
  3023. {$endif GDB}
  3024.       end;
  3025.  
  3026. {$ifdef UseBrowser}
  3027.     procedure tsym.load_references;
  3028.  
  3029.       var fileindex : word;
  3030.           b : byte;
  3031.           l : longint;
  3032.  
  3033.       begin
  3034.          b:=readbyte;
  3035.          while b=ibref do
  3036.            begin
  3037.               fileindex:=readword;
  3038.               l:=readlong;
  3039.               inc(refcount);
  3040.               lastref:=new(pref,load(lastref,fileindex,l));
  3041.               if refcount=1 then defref:=lastref;
  3042.               b:=readbyte;
  3043.            end;
  3044.          lastwritten:=lastref;
  3045.          if b <> ibend then
  3046.           Message(unit_f_ppu_read_error);
  3047.       end;
  3048.  
  3049.     procedure load_external_references;
  3050.  
  3051.       var b : byte;
  3052.           sym : psym;
  3053.           prdef : pdef;
  3054.       begin
  3055.          b:=readbyte;
  3056.          while (b=ibextsymref) or (b=ibextdefref) do
  3057.            begin
  3058.               if b=ibextsymref then
  3059.                 begin
  3060.                    sym:=readsymref;
  3061.                    resolvesym(sym);
  3062.                    sym^.load_references;
  3063.                    b:=readbyte;
  3064.                 end
  3065.               else
  3066.               if b=ibextdefref then
  3067.                 begin
  3068.                    prdef:=readdefref;
  3069.                    resolvedef(prdef);
  3070.                    if prdef^.deftype<>procdef then
  3071.                     Message(unit_f_ppu_read_error);
  3072.                    pprocdef(prdef)^.load_references;
  3073.                    b:=readbyte;
  3074.                 end;
  3075.            end;
  3076.          if b <> ibend then
  3077.            Message(unit_f_ppu_read_error);
  3078.       end;
  3079.  
  3080.     procedure tsym.write_references;
  3081.  
  3082.       var ref : pref;
  3083.  
  3084.       begin
  3085.       { references do not change the ppu caracteristics      }
  3086.       { this only save the references to variables/functions }
  3087.       { defined in the unit what about the others            }
  3088.          ppufile.do_crc:=false;
  3089.          if assigned(lastwritten) then
  3090.            ref:=lastwritten
  3091.          else
  3092.            ref:=defref;
  3093.          while assigned(ref) do
  3094.            begin
  3095.               if assigned(ref^.inputfile) then
  3096.                 begin
  3097.                    writebyte(ibref);
  3098.                    writeword(ref^.inputfile^.ref_index);
  3099.                    writelong(ref^.lineno);
  3100.                 end;
  3101.               ref:=ref^.nextref;
  3102.            end;
  3103.          lastwritten:=lastref;
  3104.          writebyte(ibend);
  3105.          ppufile.do_crc:=true;
  3106.       end;
  3107.  
  3108.     procedure tsym.write_external_references;
  3109.  
  3110.       var ref : pref;
  3111.           prdef : pdef;
  3112.       begin
  3113.          ppufile.do_crc:=false;
  3114.          if lastwritten=lastref then exit;
  3115.          writebyte(ibextsymref);
  3116.          writesymref(@self);
  3117.          if assigned(lastwritten) then
  3118.            ref:=lastwritten
  3119.          else
  3120.            ref:=defref;
  3121.          while assigned(ref) do
  3122.            begin
  3123.               if assigned(ref^.inputfile) then
  3124.                 begin
  3125.                    writebyte(ibref);
  3126.                    writeword(ref^.inputfile^.ref_index);
  3127.                    writelong(ref^.lineno);
  3128.                 end;
  3129.               ref:=ref^.nextref;
  3130.            end;
  3131.          lastwritten:=lastref;
  3132.          writebyte(ibend);
  3133.          if typ=procsym then
  3134.            begin
  3135.               prdef:=pprocsym(@self)^.definition;
  3136.               while assigned(prdef) do
  3137.                 begin
  3138.                    pprocdef(prdef)^.write_external_references;
  3139.                    prdef:=pprocdef(prdef)^.nextoverloaded;
  3140.                 end;
  3141.            end;
  3142.          ppufile.do_crc:=true;
  3143.       end;
  3144.  
  3145.     procedure tsym.write_ref_to_file(var f : text);
  3146.  
  3147.       var ref : pref;
  3148.  
  3149.       begin
  3150.          ref:=defref;
  3151.          while assigned(ref) do
  3152.            begin
  3153.               writeln(f,ref^.get_file_line);
  3154.               ref:=ref^.nextref;
  3155.            end;
  3156.       end;
  3157. {$endif UseBrowser}
  3158.  
  3159.     destructor tsym.done;
  3160.  
  3161.       begin
  3162. {$ifdef tp}
  3163.          if not(use_big) then
  3164. {$endif tp}
  3165.            strdispose(_name);
  3166.          if assigned(left) then dispose(left,done);
  3167.          if assigned(right) then dispose(right,done);
  3168.       end;
  3169.  
  3170.     procedure tsym.write;
  3171.  
  3172.       begin
  3173.          writestring(name);
  3174.          if object_options then
  3175.            ppufile.write_byte(byte(properties));
  3176. {$ifdef UseBrowser}
  3177.          if (current_module^.flags and uf_uses_browser)<>0 then
  3178.            write_references;
  3179. {$endif UseBrowser}
  3180.       end;
  3181.  
  3182.     procedure tsym.deref;
  3183.  
  3184.       begin
  3185.       end;
  3186.  
  3187.     function tsym.name : string;
  3188.  
  3189. {$ifdef tp}
  3190.       var
  3191.          s : string;
  3192.          b : byte;
  3193.  
  3194. {$endif tp}
  3195.       begin
  3196. {$ifdef tp}
  3197.          if use_big then
  3198.            begin
  3199.               symbolstream.seek(longint(_name));
  3200.               symbolstream.read(b,1);
  3201.               symbolstream.read(s[1],b);
  3202.               s[0]:=chr(b);
  3203.               name:=s;
  3204.            end
  3205.          else
  3206. {$endif}
  3207.            begin
  3208.               name:=strpas(_name);
  3209.            end;
  3210.       end;
  3211.  
  3212.     function tsym.mangledname : string;
  3213.  
  3214.       begin
  3215.          mangledname:=name;
  3216.       end;
  3217.  
  3218.     procedure tsym.setname(const s : string);
  3219.  
  3220.       begin
  3221.          setstring(_name,s);
  3222.       end;
  3223.  
  3224. {$ifdef GDB}
  3225.     function tsym.stabstring : pchar;
  3226.  
  3227.       begin
  3228.          stabstring:=strpnew('"'+name+'",'+tostr(N_LSYM)+',0,'+tostr(line_no)+',0');
  3229.       end;
  3230.  
  3231.     procedure tsym.concatstabto(asmlist : paasmoutput);
  3232.  
  3233.     var stab_str : pchar;
  3234.       begin
  3235.          if not isstabwritten then
  3236.            begin
  3237.               stab_str := stabstring;
  3238.               if asmlist = debuglist then do_count_dbx := true;
  3239.               { count_dbx(stab_str); moved to GDB.PAS }
  3240.               asmlist^.concat(new(pai_stabs,init(stab_str)));
  3241.               isstabwritten:=true;
  3242.           end;
  3243.     end;
  3244. {$endif GDB}
  3245.  
  3246. {**************************************
  3247.                TLABELSYM
  3248.  **************************************}
  3249.  
  3250.     constructor tlabelsym.init(const n : string; l : plabel);
  3251.  
  3252.       begin
  3253.          inherited init(n);
  3254.          typ:=labelsym;
  3255.          number:=l;
  3256.          number^.is_used:=false;
  3257.          number^.is_set:=true;
  3258.          number^.refcount:=0;
  3259.          defined:=false;
  3260.       end;
  3261.  
  3262.     destructor tlabelsym.done;
  3263.  
  3264.       begin
  3265.          if not(defined) then
  3266.           Message1(sym_e_label_not_defined,name);
  3267.          inherited done;
  3268.       end;
  3269.  
  3270.     function tlabelsym.mangledname : string;
  3271.  
  3272.       begin
  3273.          { this also sets the is_used field }
  3274.          mangledname:=lab2str(number);
  3275.       end;
  3276.  
  3277.     procedure tlabelsym.write;
  3278.  
  3279.       begin
  3280.          Message(sym_e_ill_label_decl);
  3281.       end;
  3282.  
  3283. {**************************************
  3284.                TUNITSYM
  3285.  **************************************}
  3286.  
  3287.     constructor tunitsym.init(const n : string;ref : punitsymtable);
  3288.  
  3289.       begin
  3290.          tsym.init(n);
  3291.          typ:=unitsym;
  3292.          unitsymtable:=ref;
  3293.          prevsym:=ref^.unitsym;
  3294.          ref^.unitsym:=@self;
  3295.          refs:=0;
  3296.       end;
  3297.  
  3298.     destructor tunitsym.done;
  3299.       begin
  3300.          if assigned(unitsymtable) and (unitsymtable^.unitsym=@self) then
  3301.            unitsymtable^.unitsym:=prevsym;
  3302.          inherited done;
  3303.       end;
  3304.     procedure tunitsym.write;
  3305.  
  3306.       begin
  3307.       end;
  3308.  
  3309. {$ifdef GDB}
  3310.     procedure tunitsym.concatstabto(asmlist : paasmoutput);
  3311.       begin
  3312.       {Nothing to write to stabs !}
  3313.       end;
  3314.  
  3315. {$endif GDB}
  3316.  
  3317. {**************************************
  3318.                TERRORSYM
  3319.  **************************************}
  3320.  
  3321.     constructor terrorsym.init;
  3322.  
  3323.       begin
  3324.          tsym.init('');
  3325.          typ:=errorsym;
  3326.       end;
  3327.  
  3328. {**************************************
  3329.                TPROPERTYSYM
  3330.  **************************************}
  3331.  
  3332.     constructor tpropertysym.init(const n : string);
  3333.  
  3334.       begin
  3335.          inherited init(n);
  3336.          typ:=propertysym;
  3337.          options:=0;
  3338.          proptype:=nil;
  3339.          readaccessdef:=nil;
  3340.          writeaccessdef:=nil;
  3341.          readaccesssym:=nil;
  3342.          writeaccesssym:=nil;
  3343.          index:=$0;
  3344.       end;
  3345.  
  3346.     destructor tpropertysym.done;
  3347.  
  3348.       begin
  3349.          inherited done;
  3350.       end;
  3351.  
  3352.     constructor tpropertysym.load;
  3353.  
  3354.       begin
  3355.          inherited load;
  3356.          typ:=propertysym;
  3357.          proptype:=readdefref;
  3358.          options:=readlong;
  3359.          index:=readlong;
  3360.          { it's hack ... }
  3361.          readaccesssym:=psym(stringdup(readstring));
  3362.          writeaccesssym:=psym(stringdup(readstring));
  3363.          { now the defs: }
  3364.          readaccessdef:=readdefref;
  3365.          writeaccessdef:=readdefref;
  3366.       end;
  3367.  
  3368.     procedure tpropertysym.deref;
  3369.  
  3370.       begin
  3371.          resolvedef(proptype);
  3372.          resolvedef(readaccessdef);
  3373.          resolvedef(writeaccessdef);
  3374.          { solve the hack we did in load: }
  3375.          if pstring(readaccesssym)^<>'' then
  3376.            begin
  3377.               srsym:=search_class_member(pobjectdef(owner^.defowner),pstring(readaccesssym)^);
  3378.               if not(assigned(srsym)) then
  3379.                 srsym:=generrorsym;
  3380.            end
  3381.          else
  3382.            srsym:=nil;
  3383.          stringdispose(pstring(readaccesssym));
  3384.          readaccesssym:=srsym;
  3385.          if pstring(writeaccesssym)^<>'' then
  3386.            begin
  3387.               srsym:=search_class_member(pobjectdef(owner^.defowner),pstring(writeaccesssym)^);
  3388.               if not(assigned(srsym)) then
  3389.                 srsym:=generrorsym;
  3390.            end
  3391.          else
  3392.            srsym:=nil;
  3393.          stringdispose(pstring(writeaccesssym));
  3394.          writeaccesssym:=srsym;
  3395.       end;
  3396.  
  3397.     function tpropertysym.getsize : longint;
  3398.  
  3399.       begin
  3400.          getsize:=0;
  3401.       end;
  3402.  
  3403.     procedure tpropertysym.write;
  3404.  
  3405.       begin
  3406.          ppufile.write_byte(ibpropertysym);
  3407.          tsym.write;
  3408.          writedefref(proptype);
  3409.          ppufile.write_long(options);
  3410.          ppufile.write_long(index);
  3411.          writestring(readaccesssym^.name);
  3412.          writestring(writeaccesssym^.name);
  3413.          writedefref(readaccessdef);
  3414.          writedefref(writeaccessdef);
  3415.       end;
  3416.  
  3417. {$ifdef GDB}
  3418.     function tpropertysym.stabstring : pchar;
  3419.  
  3420.       begin
  3421.          { !!!! don't know how to handle }
  3422.          stabstring:=strpnew('');
  3423.       end;
  3424.  
  3425.     procedure tpropertysym.concatstabto(asmlist : paasmoutput);
  3426.  
  3427.       begin
  3428.          { !!!! don't know how to handle }
  3429.       end;
  3430. {$endif GDB}
  3431.  
  3432. {$ifdef TEST_FUNCRET}
  3433. {**************************************
  3434.                TFUNCRETSYM
  3435.  **************************************}
  3436.     constructor tfuncretsym.init(const n : string;approcinfo : pprocinfo);
  3437.  
  3438.       begin
  3439.          tsym.init(n);
  3440.          funcretprocinfo:=approcinfo;
  3441.          funcretdef:=approcinfo^.retdef;
  3442.          { address valid for ret in param only }
  3443.          { otherwise set by insert             }
  3444.          address:=approcinfo^.retoffset;
  3445.       end;
  3446. {$endif TEST_FUNCRET}
  3447.  
  3448. {**************************************
  3449.                TABSOLUTESYM
  3450.  **************************************}
  3451.  
  3452. {   constructor tabsolutesym.init(const s : string;p : pdef;newref : psym);
  3453.      begin
  3454.         inherited init(s,p);
  3455.         ref:=newref;
  3456.         typ:=absolutesym;
  3457.      end; }
  3458.  
  3459.     constructor tabsolutesym.load;
  3460.  
  3461.       begin
  3462.          tvarsym.load;
  3463.          typ:=absolutesym;
  3464.          ref:=nil;
  3465.          address:=0;
  3466.          asmname:=nil;
  3467.          abstyp:=absolutetyp(readbyte);
  3468.          absseg:=false;
  3469.          case abstyp of
  3470.             tovar:
  3471.               begin
  3472.                  asmname:=stringdup(readstring);
  3473.                  ref:=srsym;
  3474.               end;
  3475.             toasm:
  3476.               asmname:=stringdup(readstring);
  3477.             toaddr:
  3478.               address:=readlong;
  3479.          end;
  3480.       end;
  3481.  
  3482.     procedure tabsolutesym.write;
  3483.  
  3484.       begin
  3485.          ppufile.write_byte(ibabsolutesym);
  3486.          tsym.write;
  3487.          ppufile.write_byte(byte(varspez));
  3488.          if read_member then
  3489.            ppufile.write_long(address);
  3490.          writedefref(definition);
  3491.          ppufile.write_byte(byte(abstyp));
  3492.          case abstyp of
  3493.             tovar:
  3494.               writestring(ref^.name);
  3495.             toasm:
  3496.               writestring(asmname^);
  3497.             toaddr:
  3498.               ppufile.write_long(address);
  3499.          end;
  3500.       end;
  3501.  
  3502.     procedure tabsolutesym.deref;
  3503.  
  3504.       begin
  3505.          resolvedef(definition);
  3506.          if (abstyp=tovar) and (asmname<>nil) then
  3507.            begin
  3508.               { search previous loaded symtables }
  3509.               getsym(asmname^,false);
  3510.               if not(assigned(srsym)) then
  3511.                 getsymonlyin(owner,asmname^);
  3512.               if not(assigned(srsym)) then
  3513.                 srsym:=generrorsym;
  3514.               ref:=srsym;
  3515.               stringdispose(asmname);
  3516.            end;
  3517.       end;
  3518.  
  3519.     function tabsolutesym.mangledname : string;
  3520.  
  3521.       begin
  3522.          case abstyp of
  3523.            tovar:
  3524.              mangledname:=ref^.mangledname;
  3525.            toasm:
  3526.              mangledname:=asmname^;
  3527.            toaddr:
  3528.              mangledname:='$'+tostr(address);
  3529.          else
  3530.            internalerror(10002);
  3531.          end;
  3532.       end;
  3533.  
  3534. {$ifdef GDB}
  3535.     procedure tabsolutesym.concatstabto(asmlist : paasmoutput);
  3536.  
  3537.       begin
  3538.       { I don't know how to handle this !! }
  3539.       end;
  3540.  
  3541. {$endif GDB}
  3542. {**************************************
  3543.                TVARSYM
  3544.  **************************************}
  3545.  
  3546.     constructor tvarsym.init(const n : string;p : pdef);
  3547.  
  3548.       begin
  3549.          tsym.init(n);
  3550.          typ:=varsym;
  3551.          definition:=p;
  3552.          varspez:=vs_value;
  3553.          address:=0;
  3554.          refs:=0;
  3555.          is_valid := 1;
  3556.          { can we load the value into a register ? }
  3557.          case p^.deftype of
  3558.             pointerdef,enumdef,procvardef : regable:=true;
  3559.             orddef : case porddef(p)^.typ of
  3560.                           u8bit,s32bit,bool8bit,uchar,
  3561.                           s8bit,s16bit,u16bit,u32bit : regable:=true;
  3562.                           else regable:=false;
  3563.                        end;
  3564.             else regable:=false;
  3565.          end;
  3566.          reg:=R_NO;
  3567.       end;
  3568.  
  3569.     constructor tvarsym.load;
  3570.  
  3571.       begin
  3572.          tsym.load;
  3573.          typ:=varsym;
  3574.          varspez:=tvarspez(readbyte);
  3575.          if read_member then
  3576.            address:=readlong
  3577.          else address:=0;
  3578.          definition:=readdefref;
  3579.          refs := 0;
  3580.          is_valid := 1;
  3581.          { symbols which are load are never candidates for a register }
  3582.          regable:=false;
  3583.          reg:=R_NO;
  3584.       end;
  3585.  
  3586.     procedure tvarsym.deref;
  3587.  
  3588.       begin
  3589.          resolvedef(definition);
  3590.       end;
  3591.  
  3592.     procedure tvarsym.write;
  3593.  
  3594.       begin
  3595.          ppufile.write_byte(ibvarsym);
  3596.          tsym.write;
  3597.          ppufile.write_byte(byte(varspez));
  3598.  
  3599.          if read_member then
  3600.            ppufile.write_long(address);
  3601.  
  3602.          writedefref(definition);
  3603.       end;
  3604.  
  3605.     function tvarsym.mangledname : string;
  3606.  
  3607.       var prefix : string;
  3608.       begin
  3609.          case owner^.symtabletype of
  3610. {$ifndef MAKELIB}
  3611.            staticsymtable : prefix:='_';
  3612. {$else MAKELIB}
  3613.            staticsymtable : prefix:='_'+owner^.name^+'$$$_';
  3614. {$endif MAKELIB}
  3615.            unitsymtable,globalsymtable : prefix:='U_'+owner^.name^+'_';
  3616.            else
  3617.              begin
  3618.                 { static data filed are converted in parser.pas to
  3619.                   a global variable }
  3620.                 Message(sym_e_invalid_call_tvarsymmangledname);
  3621.              end;
  3622.            end;
  3623.          mangledname:=prefix+name;
  3624.       end;
  3625.  
  3626. {$ifdef GDB}
  3627.     function tvarsym.stabstring : pchar;
  3628.  
  3629.     var st : char;
  3630.  
  3631.     begin
  3632.        if (owner^.symtabletype = objectsymtable) and
  3633.           ((properties and sp_static)<>0) then
  3634.          begin
  3635.             if use_gsym then st := 'G' else st := 'S';
  3636.             stabstring := strpnew('"'+owner^.name^+'__'+name+':'+
  3637.                      +definition^.numberstring+'",'+
  3638.                      tostr(N_LCSYM)+',0,'+tostr(line_no)+','+mangledname);
  3639.          end
  3640.        else if (owner^.symtabletype = globalsymtable) or
  3641.           (owner^.symtabletype = unitsymtable) then
  3642.          begin
  3643.             { Here we used S instead of
  3644.               because with G GDB doesn't look at the address field
  3645.               but searches the same name or with a leading underscore
  3646.               but these names don't exist in pascal !}
  3647.             if use_gsym then st := 'G' else st := 'S';
  3648.             stabstring := strpnew('"'+name+':'+st
  3649.                      +definition^.numberstring+'",'+
  3650.                      tostr(N_LCSYM)+',0,'+tostr(line_no)+','+mangledname);
  3651.          end
  3652.        else if owner^.symtabletype = staticsymtable then
  3653.          begin
  3654.             stabstring := strpnew('"'+name+':S'
  3655.                   +definition^.numberstring+'",'+
  3656.                   tostr(N_LCSYM)+',0,'+tostr(line_no)+','+mangledname);
  3657.          end
  3658.        else if (owner^.symtabletype=parasymtable) then
  3659.          begin
  3660.             case varspez of
  3661.                vs_value : st := 'p';
  3662.                vs_var   : st := 'v';
  3663.                vs_const : st := 'v';{ should be 'i' but 'i' doesn't work }
  3664.               end;
  3665.             stabstring := strpnew('"'+name+':'+st
  3666.                   +definition^.numberstring+'",'+
  3667.                   tostr(N_PSYM)+',0,'+tostr(line_no)+','+tostr(address+owner^.call_offset))
  3668.                   {offset to ebp => will not work if the framepointer is esp
  3669.                   so some optimizing will make things harder to debug }
  3670.          end
  3671.        else if (owner^.symtabletype=localsymtable) then
  3672.    {$ifdef i386}
  3673.          if reg<>R_NO then
  3674.            begin
  3675.               { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
  3676.               { this is the register order for GDB }
  3677.               stabstring:=strpnew('"'+name+':r'
  3678.                         +definition^.numberstring+'",'+
  3679.                         tostr(N_RSYM)+',0,'+tostr(line_no)+','+tostr(GDB_i386index[reg]));
  3680.            end
  3681.          else
  3682.    {$endif i386}
  3683.            stabstring := strpnew('"'+name+':'
  3684.                   +definition^.numberstring+'",'+
  3685.                   tostr(N_LSYM)+',0,'+tostr(line_no)+',-'+tostr(address))
  3686.        else
  3687.          stabstring := inherited stabstring;
  3688.   end;
  3689.  
  3690.     procedure tvarsym.concatstabto(asmlist : paasmoutput);
  3691.       var stab_str : pchar;
  3692.       begin
  3693.          inherited concatstabto(asmlist);
  3694. {$ifdef i386}
  3695.       if (owner^.symtabletype=parasymtable) and
  3696.          (reg<>R_NO) then
  3697.            begin
  3698.            { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
  3699.            { this is the register order for GDB }
  3700.               stab_str:=strpnew('"'+name+':r'
  3701.                      +definition^.numberstring+'",'+
  3702.                      tostr(N_RSYM)+',0,'+tostr(line_no)+','+tostr(GDB_i386index[reg]));
  3703.               asmlist^.concat(new(pai_stabs,init(stab_str)));
  3704.            end;
  3705. {$endif i386}
  3706.       end;
  3707.  
  3708. {$endif GDB}
  3709.     function tvarsym.getsize : longint;
  3710.  
  3711.       begin
  3712.          { only if the definition is set, we could determine the   }
  3713.          { size, this is if an error occurs while reading the type }
  3714.          { also used for operator, this allows not to allocate the }
  3715.          { return size twice                                       }
  3716.          if assigned(definition) then
  3717.            begin
  3718.               case varspez of
  3719.                  vs_value : getsize:=definition^.size;
  3720.                  vs_var : getsize:=4;
  3721.                  vs_const : begin
  3722.                                if (definition^.deftype=stringdef) or
  3723.                                   (definition^.deftype=arraydef) or
  3724.                                   (definition^.deftype=recorddef) or
  3725.                                   (definition^.deftype=objectdef) or
  3726.                                   (definition^.deftype=setdef) then
  3727.                                   getsize:=4
  3728.                                 else
  3729.                                   getsize:=definition^.size;
  3730.                             end;
  3731.               end;
  3732.            end
  3733.          else
  3734.            getsize:=0;
  3735.       end;
  3736.  
  3737. {**************************************
  3738.                TTYPEDCONSTSYM
  3739.  **************************************}
  3740.  
  3741.     constructor ttypedconstsym.init(const n : string;p : pdef);
  3742.  
  3743.       begin
  3744.          tsym.init(n);
  3745.          typ:=typedconstsym;
  3746.          definition:=p;
  3747.          prefix:=stringdup(procprefix);
  3748.       end;
  3749.  
  3750.     constructor ttypedconstsym.load;
  3751.  
  3752.       begin
  3753.          tsym.load;
  3754.          typ:=typedconstsym;
  3755.          definition:=readdefref;
  3756.          prefix:=stringdup(readstring);
  3757.       end;
  3758.  
  3759.     destructor ttypedconstsym.done;
  3760.  
  3761.       begin
  3762.          stringdispose(prefix);
  3763.          tsym.done;
  3764.       end;
  3765.  
  3766.     function ttypedconstsym.mangledname : string;
  3767.  
  3768.       begin
  3769.          mangledname:='TC_'+prefix^+'_'+name;
  3770.       end;
  3771.  
  3772.     procedure ttypedconstsym.deref;
  3773.  
  3774.       begin
  3775.          resolvedef(definition);
  3776.       end;
  3777.  
  3778.     procedure ttypedconstsym.write;
  3779.  
  3780.       begin
  3781.          ppufile.write_byte(ibtypedconstsym);
  3782.          tsym.write;
  3783.          writedefref(definition);
  3784.          writestring(prefix^);
  3785.       end;
  3786.  
  3787. {$ifdef GDB}
  3788.     function ttypedconstsym.stabstring : pchar;
  3789.     var st : char;
  3790.     begin
  3791.     if use_gsym and ((owner^.symtabletype = unitsymtable)
  3792.       or (owner^.symtabletype = globalsymtable)) then
  3793.        st := 'G' else st := 'S';
  3794.     stabstring := strpnew('"'+name+':'+st
  3795.             +definition^.numberstring+'",'+tostr(n_STSYM)+',0,'+tostr(line_no)+','+mangledname);
  3796.     end;
  3797. {$endif GDB}
  3798.  
  3799. {**************************************
  3800.                TCONSTSYM
  3801.  **************************************}
  3802.  
  3803.     constructor tconstsym.init(const n : string;t : tconsttype;v : longint;def : pdef);
  3804.  
  3805.       begin
  3806.          tsym.init(n);
  3807.          typ:=constsym;
  3808.          definition:=def;
  3809.          consttype:=t;
  3810.          value:=v;
  3811.       end;
  3812.  
  3813.     constructor tconstsym.load;
  3814.  
  3815.       var
  3816.          pd : pdouble;
  3817.          ps : pointer;  {***SETCONST}
  3818.  
  3819.       begin
  3820.          tsym.load;
  3821.          typ:=constsym;
  3822.          consttype:=tconsttype(readbyte);
  3823.          case consttype of
  3824.             constint,
  3825.             constbool,
  3826.             constchar : value:=readlong;
  3827.             constord : begin
  3828.                           definition:=readdefref;
  3829.                           value:=readlong;
  3830.                        end;
  3831.             conststring : value:=longint(stringdup(readstring));
  3832.             constreal : begin
  3833.                            new(pd);
  3834.                            pd^:=readdouble;
  3835.                            value:=longint(pd);
  3836.                         end;
  3837. {***SETCONST}
  3838.             constseta : begin
  3839.                            getmem(ps,32);
  3840.                            readset(ps^);
  3841.                            value:=longint(ps);
  3842.                        end;
  3843. {***}
  3844.          else Message1(unit_f_ppu_invalid_entry,tostr(ord(consttype)));
  3845.          end;
  3846.       end;
  3847.  
  3848. {$ifdef GDB}
  3849.     destructor tconstsym.done;
  3850.       begin
  3851.       if consttype = conststring then stringdispose(pstring(value));
  3852.       inherited done;
  3853.       end;
  3854. {$endif GDB}
  3855.  
  3856.     function tconstsym.mangledname : string;
  3857.  
  3858.       begin
  3859.          mangledname:=name;
  3860.       end;
  3861.  
  3862.     procedure tconstsym.deref;
  3863.  
  3864.       begin
  3865.          if consttype=constord then
  3866.            resolvedef(pdef(definition));
  3867.       end;
  3868.  
  3869.     procedure tconstsym.write;
  3870.  
  3871.       begin
  3872.          ppufile.write_byte(ibconstsym);
  3873.          tsym.write;
  3874.          ppufile.write_byte(byte(consttype));
  3875.          case consttype of
  3876.             constint,
  3877.             constbool,
  3878.             constchar : ppufile.write_long(value);
  3879.             constord : begin
  3880.                           writedefref(definition);
  3881.                           ppufile.write_long(value);
  3882.                        end;
  3883.             conststring : writestring(pstring(value)^);
  3884.             constreal : ppufile.write_double(pdouble(value)^);
  3885. {***SETCONST}
  3886.             constseta: writeset(pointer(value)^);
  3887. {***}
  3888.             else internalerror(13);
  3889.          end;
  3890.       end;
  3891.  
  3892. {$ifdef GDB}
  3893.     function tconstsym.stabstring : pchar;
  3894.     var st : string;
  3895.     begin
  3896.          {even GDB v4.16 only now 'i' 'r' and 'e' !!!}
  3897.          case consttype of
  3898.             conststring : begin
  3899.                           { I had to remove ibm2ascii !! }
  3900.                           st := pstring(value)^;
  3901.                           {st := ibm2ascii(pstring(value)^);}
  3902.                           st := 's'''+st+'''';
  3903.                           end;
  3904.             constbool, constint, constord, constchar : st := 'i'+tostr(value);
  3905.             constreal : begin
  3906.                         system.str(pdouble(value)^,st);
  3907.                         st := 'r'+st;
  3908.                         end;
  3909.          { if we don't know just put zero !! }
  3910.          else st:='i0';
  3911.             {***SETCONST}
  3912.             {constset:;}    {*** I don't know what to do with a set.}
  3913.          { sets are not recognized by GDB }
  3914.             {***}
  3915.         end;
  3916.     stabstring := strpnew('"'+name+':c='+st+'",'+tostr(N_function)+',0,'+tostr(line_no)+',0');
  3917.     end;
  3918.  
  3919.     procedure tconstsym.concatstabto(asmlist : paasmoutput);
  3920.  
  3921.       begin
  3922.           if consttype <> conststring then inherited concatstabto(asmlist);
  3923.       end;
  3924.  
  3925. {$endif GDB}
  3926.  
  3927. {**************************************
  3928.                tenumsym
  3929.  **************************************}
  3930.  
  3931.     constructor tenumsym.init(const n : string;def : penumdef;v : longint);
  3932.       begin
  3933.          tsym.init(n);
  3934.          typ:=enumsym;
  3935.          definition:=def;
  3936.          value:=v;
  3937. {$ifdef GDB}
  3938.          order;
  3939. {$endif GDB}
  3940.       end;
  3941.  
  3942.     constructor tenumsym.load;
  3943.  
  3944.       begin
  3945.          tsym.load;
  3946.          typ:=enumsym;
  3947.          definition:=penumdef(readdefref);
  3948.          value:=readlong;
  3949. {$ifdef GDB}
  3950.          next := Nil;
  3951. {$endif GDB}
  3952.       end;
  3953.  
  3954.     procedure tenumsym.deref;
  3955.  
  3956.       begin
  3957.          resolvedef(pdef(definition));
  3958. {$ifdef GDB}
  3959.          order;
  3960. {$endif}
  3961.       end;
  3962.  
  3963. {$ifdef GDB}
  3964.          procedure tenumsym.order;
  3965.          var sym : penumsym;
  3966.          begin
  3967.          sym := definition^.first;
  3968.          if sym = nil then
  3969.            begin
  3970.            definition^.first := @self;
  3971.            next := nil;
  3972.            exit;
  3973.            end;
  3974.          {reorder the symbols in increasing value }
  3975.          if value < sym^.value then
  3976.            begin
  3977.            next := sym;
  3978.            definition^.first := @self;
  3979.            end else
  3980.            begin
  3981.            while (sym^.value <= value) and assigned(sym^.next) do
  3982.              sym := sym^.next;
  3983.            next := sym^.next;
  3984.            sym^.next := @self;
  3985.            end;
  3986.          end;
  3987. {$endif GDB}
  3988.  
  3989.     procedure tenumsym.write;
  3990.  
  3991.       begin
  3992.          ppufile.write_byte(ibaufzaehlsym);
  3993.          tsym.write;
  3994.          writedefref(definition);
  3995.          ppufile.write_long(value);
  3996.       end;
  3997.  
  3998. {$ifdef GDB}
  3999.     procedure tenumsym.concatstabto(asmlist : paasmoutput);
  4000.     begin
  4001.     {enum elements have no stab !}
  4002.     end;
  4003. {$EndIf GDB}
  4004.  
  4005. {**************************************
  4006.                TTYPESYM
  4007.  **************************************}
  4008.  
  4009.     constructor ttypesym.init(const n : string;d : pdef);
  4010.  
  4011.       begin
  4012.          tsym.init(n);
  4013.          typ:=typesym;
  4014.          definition:=d;
  4015.          forwardpointer:=nil;
  4016.          { this allows to link definitions with the type with declares }
  4017.          { them                                                        }
  4018.          if assigned(definition) then
  4019.            if definition^.sym=nil then
  4020.              definition^.sym:=@self;
  4021.       end;
  4022.  
  4023.     constructor ttypesym.load;
  4024.  
  4025.       begin
  4026.          tsym.load;
  4027.          typ:=typesym;
  4028.          forwardpointer:=nil;
  4029.          definition:=readdefref;
  4030.       end;
  4031.  
  4032.     destructor ttypesym.done;
  4033.  
  4034.       begin
  4035.          if assigned(definition) then
  4036.            if definition^.sym=@self then
  4037.              definition^.sym:=nil;
  4038.          inherited done;
  4039.       end;
  4040.  
  4041.     procedure ttypesym.deref;
  4042.  
  4043.       begin
  4044.          resolvedef(definition);
  4045.          if assigned(definition) then
  4046.            if definition^.sym=nil then
  4047.              definition^.sym:=@self;
  4048.       end;
  4049.  
  4050.     procedure ttypesym.write;
  4051.  
  4052.       begin
  4053.          ppufile.write_byte(ibtypesym);
  4054.          tsym.write;
  4055.          writedefref(definition);
  4056.       end;
  4057.  
  4058. {$ifdef GDB}
  4059.     function ttypesym.stabstring : pchar;
  4060.     var stabchar : string[2];
  4061.         short : string;
  4062.     begin
  4063.       if definition^.deftype in tagtypes then
  4064.         stabchar := 'Tt'
  4065.         else stabchar := 't';
  4066.     short := '"'+name+':'+stabchar+definition^.numberstring
  4067.                +'",'+tostr(N_LSYM)+',0,'+tostr(line_no)+',0';
  4068.     stabstring := strpnew(short);
  4069.     end;
  4070.  
  4071.     procedure ttypesym.concatstabto(asmlist : paasmoutput);
  4072.       begin
  4073.       {not stabs for forward defs }
  4074.       if assigned(definition) then
  4075.         if (definition^.sym = @self) then
  4076.         definition^.concatstabto(asmlist)
  4077.         else
  4078.         begin
  4079.         inherited concatstabto(asmlist);
  4080.         end;
  4081.       end;
  4082.  
  4083. {$endif GDB}
  4084.  
  4085. {**************************************
  4086.                TPROCSYM
  4087.  **************************************}
  4088.  
  4089.     procedure tprocsym.write;
  4090.  
  4091.       begin
  4092.          ppufile.write_byte(ibprocsym);
  4093.          tsym.write;
  4094.          writedefref(pdef(definition));
  4095.       end;
  4096.  
  4097. {$ifdef GDB}
  4098.     function tprocsym.stabstring : pchar;
  4099.      Var RetType : Char;
  4100.          Obj,Info : String;
  4101.     begin
  4102.       obj := name;
  4103.       info := '';
  4104.       if is_global then
  4105.        RetType := 'F'
  4106.       else
  4107.        RetType := 'f';
  4108.      if assigned(owner) then
  4109.       begin
  4110.         if (owner^.symtabletype = objectsymtable) then
  4111.          obj := owner^.name^+'__'+name;
  4112.         if (owner^.symtabletype=localsymtable) and assigned(owner^.name) then
  4113.          info := ','+name+','+owner^.name^;
  4114.       end;
  4115.      stabstring :=strpnew('"'+obj+':'+RetType
  4116.            +definition^.retdef^.numberstring+info+'",'+tostr(n_function)
  4117.            +',0,'+tostr(current_module^.current_inputfile^.line_no)
  4118.            +','+definition^.mangledname);
  4119.     end;
  4120.  
  4121.     procedure tprocsym.concatstabto(asmlist : paasmoutput);
  4122.     begin
  4123.     if (definition^.options and pointernproc) <> 0 then exit;
  4124.     if not isstabwritten then
  4125.       asmlist^.concat(new(pai_stabs,init(stabstring)));
  4126.     isstabwritten := true;
  4127.     if assigned(definition^.parast) then
  4128.       definition^.parast^.concatstabto(asmlist);
  4129.     if assigned(definition^.localst) then
  4130.       definition^.localst^.concatstabto(asmlist);
  4131.     definition^.isstabwritten := true;
  4132.     end;
  4133.  
  4134. {$endif GDB}
  4135. {**************************************
  4136.                TSYSSYM
  4137.  **************************************}
  4138.  
  4139.     constructor tsyssym.init(const n : string;l : longint);
  4140.  
  4141.       begin
  4142.          inherited init(n);
  4143.          typ:=syssym;
  4144.          number:=l;
  4145.       end;
  4146.  
  4147.     procedure tsyssym.write;
  4148.  
  4149.       begin
  4150.       end;
  4151.  
  4152. {$ifdef GDB}
  4153.     procedure tsyssym.concatstabto(asmlist : paasmoutput);
  4154.  
  4155.       begin
  4156.       end;
  4157.  
  4158. {$endif GDB}
  4159. {**************************************
  4160.                TMACROSYM
  4161.  **************************************}
  4162.  
  4163.     constructor tmacrosym.init(const n : string);
  4164.  
  4165.       begin
  4166.          inherited init(n);
  4167.          defined:=true;
  4168.          buftext:=nil;
  4169.          buflen:=0;
  4170.       end;
  4171.  
  4172.     destructor tmacrosym.done;
  4173.  
  4174.       begin
  4175.          if assigned(buftext) then
  4176.            freemem(buftext,buflen);
  4177.          inherited done;
  4178.       end;
  4179.  
  4180.     procedure maybe_concat_external(symt : psymtable;const name : string);
  4181.  
  4182.       begin
  4183.          if (symt^.symtabletype=unitsymtable) or
  4184.             ((symt^.symtabletype=objectsymtable) and
  4185.             (symt^.defowner^.owner^.symtabletype=unitsymtable)) then
  4186.            concat_external(name,EXT_NEAR);
  4187.       end;
  4188.  
  4189.     function globaldef(const s : string) : pdef;
  4190.  
  4191.       var st : string;
  4192.           symt : psymtable;
  4193.       begin
  4194.          srsym := nil;
  4195.          if pos('.',s) > 0 then
  4196.            begin
  4197.            st := copy(s,1,pos('.',s)-1);
  4198.            getsym(st,false);
  4199.            st := copy(s,pos('.',s)+1,255);
  4200.            if assigned(srsym) then
  4201.              begin
  4202.              if srsym^.typ = unitsym then
  4203.                begin
  4204.                symt := punitsym(srsym)^.unitsymtable;
  4205.                srsym := symt^.search(st);
  4206.                end else srsym := nil;
  4207.              end;
  4208.            end else st := s;
  4209.          if srsym = nil then getsym(st,false);
  4210.          if srsym = nil then
  4211.            getsymonlyin(systemunit,st);
  4212.          if srsym^.typ<>typesym then
  4213.            begin
  4214.              Message(sym_e_type_id_expected);
  4215.              exit;
  4216.            end;
  4217.          globaldef := ptypesym(srsym)^.definition;
  4218.       end;
  4219.  
  4220. {$ifdef GDB}
  4221.     function typeglobalnumber(const s : string) : string;
  4222.  
  4223.       var st : string;
  4224.           symt : psymtable;
  4225.       begin
  4226.          typeglobalnumber := '0';
  4227.          srsym := nil;
  4228.          if pos('.',s) > 0 then
  4229.            begin
  4230.            st := copy(s,1,pos('.',s)-1);
  4231.            getsym(st,false);
  4232.            st := copy(s,pos('.',s)+1,255);
  4233.            if assigned(srsym) then
  4234.              begin
  4235.              if srsym^.typ = unitsym then
  4236.                begin
  4237.                symt := punitsym(srsym)^.unitsymtable;
  4238.                srsym := symt^.search(st);
  4239.                end else srsym := nil;
  4240.              end;
  4241.            end else st := s;
  4242.          if srsym = nil then getsym(st,true);
  4243.          if srsym^.typ<>typesym then
  4244.            begin
  4245.              Message(sym_e_type_id_expected);
  4246.              exit;
  4247.            end;
  4248.          typeglobalnumber := ptypesym(srsym)^.definition^.numberstring;
  4249.       end;
  4250. {$endif GDB}
  4251.  
  4252. {**************************************
  4253.                   TDEF
  4254.  **************************************}
  4255.  
  4256.  
  4257. { base class for type definitions }
  4258.  
  4259.     constructor tdef.init;
  4260.  
  4261.       begin
  4262.          deftype:=abstractdef;
  4263. {$ifdef GDB}
  4264.          owner := nil;
  4265.          next := nil;
  4266.          number := 0;
  4267.          globalnb := 0;
  4268. {$endif GDB}
  4269.          if registerdef then symtablestack^.registerdef(@self);
  4270. {$ifdef GDB}
  4271.          isstabwritten := false;
  4272.          if assigned(lastglobaldef) then
  4273.            lastglobaldef^.nextglobal := @self
  4274.            else firstglobaldef := @self;
  4275.          lastglobaldef := @self;
  4276.          nextglobal := nil;
  4277.          sym := nil;
  4278. {$endif GDB}
  4279.       end;
  4280.  
  4281. {$ifdef GDB}
  4282.     constructor tdef.load;
  4283.       begin
  4284.          deftype:=abstractdef;
  4285.          isstabwritten := false;
  4286.          number := 0;
  4287.          if assigned(lastglobaldef) then
  4288.            lastglobaldef^.nextglobal := @self
  4289.            else firstglobaldef := @self;
  4290.          lastglobaldef := @self;
  4291.          nextglobal := nil;
  4292.          sym := nil;
  4293.          owner := nil;
  4294.          next := nil;
  4295.       end;
  4296.  
  4297.    procedure tdef.set_globalnb;
  4298.      begin
  4299.          globalnb :=PGlobalTypeCount^;
  4300.          inc(PglobalTypeCount^);
  4301.      end;
  4302. {$endif GDB}
  4303.     function tdef.size : longint;
  4304.  
  4305.       begin
  4306.          size:=savesize;
  4307.       end;
  4308.  
  4309.     procedure tdef.write;
  4310.  
  4311.       begin
  4312. {$ifdef GDB }
  4313.       if globalnb = 0 then
  4314.         begin
  4315.         if assigned(owner) then
  4316.           globalnb := owner^.getnewtypecount
  4317.         else
  4318.           begin
  4319.           globalnb := PGlobalTypeCount^;
  4320.           Inc(PGlobalTypeCount^);
  4321.           end;
  4322.         end;
  4323. {$endif GDB }
  4324.       end;
  4325.  
  4326. {$ifdef GDB}
  4327.     function tdef.stabstring : pchar;
  4328.  
  4329.       begin
  4330.       stabstring := strpnew('t'+numberstring+';');
  4331.       end;
  4332.  
  4333.     function tdef.numberstring : string;
  4334.       var table : psymtable;
  4335.       begin
  4336.       {formal def have no type !}
  4337.       if deftype = formaldef then
  4338.         begin
  4339.         numberstring := voiddef^.numberstring;
  4340.         exit;
  4341.         end;
  4342.       if not assigned(sym) or not(sym^.isusedinstab) then
  4343.         begin
  4344.            {set even if debuglist is not defined}
  4345.            if assigned(sym) and (sym^.typ=typesym) then
  4346.              sym^.isusedinstab := true;
  4347.            if assigned(debuglist) and not isstabwritten then
  4348.              concatstabto(debuglist);
  4349.         end;
  4350.       if not use_dbx then
  4351.         begin
  4352.            if globalnb = 0 then
  4353.              set_globalnb;
  4354.            numberstring := tostr(globalnb);
  4355.         end
  4356.       else
  4357.         begin
  4358.            if globalnb = 0 then
  4359.              begin
  4360.                 if assigned(owner) then
  4361.                   globalnb := owner^.getnewtypecount
  4362.                 else
  4363.                   begin
  4364.                      globalnb := PGlobalTypeCount^;
  4365.                      Inc(PGlobalTypeCount^);
  4366.                   end;
  4367.              end;
  4368.            if assigned(sym) then
  4369.              begin
  4370.                 table := sym^.owner;
  4371.                 if table^.unitid > 0 then
  4372.                   numberstring := '('+tostr(table^.unitid)+','+tostr(sym^.definition^.globalnb)+')'
  4373.                 else
  4374.                   numberstring := tostr(globalnb);
  4375.                 exit;
  4376.              end;
  4377.            numberstring := tostr(globalnb);
  4378.         end;
  4379.       end;
  4380.  
  4381.     function tdef.allstabstring : pchar;
  4382.     var stabchar : string[2];
  4383.         ss,st : pchar;
  4384.         name : string;
  4385.         sym_line_no : longint;
  4386.       begin
  4387.       ss := stabstring;
  4388.       getmem(st,strlen(ss)+512);
  4389.       stabchar := 't';
  4390.       if deftype in tagtypes then
  4391.         stabchar := 'Tt';
  4392.       if assigned(sym) then
  4393.         begin
  4394.            name := sym^.name;
  4395.            sym_line_no:=sym^.line_no;
  4396.         end
  4397.       else
  4398.         begin
  4399.            name := ' ';
  4400.            sym_line_no:=0;
  4401.         end;
  4402.       strpcopy(st,'"'+name+':'+stabchar+numberstring+'=');
  4403.       strpcopy(strecopy(strend(st),ss),'",'+tostr(N_LSYM)+',0,'+tostr(sym_line_no)+',0');
  4404.       allstabstring := strnew(st);
  4405.       freemem(st,strlen(ss)+512);
  4406.       strdispose(ss);
  4407.       end;
  4408.  
  4409.  
  4410.     procedure tdef.concatstabto(asmlist : paasmoutput);
  4411.      var stab_str : pchar;
  4412.     begin
  4413.     if ((sym = nil) or sym^.isusedinstab or use_dbx)
  4414.       and not isstabwritten then
  4415.       begin
  4416.       If use_dbx then
  4417.         begin
  4418.            { otherwise you get two of each def }
  4419.            If assigned(sym) then
  4420.              begin
  4421.                 if sym^.typ=typesym then
  4422.                   sym^.isusedinstab:=true;
  4423.                 if (sym^.owner = nil) or
  4424.                   ((sym^.owner^.symtabletype = unitsymtable) and
  4425.                  punitsymtable(sym^.owner)^.dbx_count_ok)  then
  4426.                 begin
  4427.                    {with DBX we get the definition from the other objects }
  4428.                    isstabwritten := true;
  4429.                    exit;
  4430.                 end;
  4431.              end;
  4432.         end;
  4433.       { to avoid infinite loops }
  4434.       isstabwritten := true;
  4435.       stab_str := allstabstring;
  4436.       if asmlist = debuglist then do_count_dbx := true;
  4437.       { count_dbx(stab_str); moved to GDB.PAS}
  4438.       asmlist^.concat(new(pai_stabs,init(stab_str)));
  4439.       end;
  4440.     end;
  4441.  
  4442. {$endif GDB}
  4443.     procedure tdef.deref;
  4444.  
  4445.       begin
  4446.       end;
  4447.  
  4448.     destructor tdef.done;
  4449. {$ifdef debug}
  4450.     var prev : pdef;
  4451. {$endif debug}
  4452.  
  4453. {$ifndef GDB}
  4454.  
  4455. {$else GDB}
  4456.       var pd : pdef;
  4457.       begin
  4458.       pd := firstglobaldef;
  4459.       if pd = @self then firstglobaldef := pd^.nextglobal
  4460.         else while assigned(pd) do
  4461. {$endif GDB}
  4462.       begin
  4463. {$ifdef GDB}
  4464.          if pd^.nextglobal = @Self then
  4465.            begin
  4466.               pd^.nextglobal := pd^.nextglobal^.nextglobal;
  4467.               if pd^.nextglobal = nil then
  4468.                 lastglobaldef := pd;
  4469.               break;
  4470.            end;
  4471. {$ifdef debug}
  4472.          prev:=pd;
  4473. {$endif debug}
  4474.          pd := pd^.nextglobal;
  4475.       end;
  4476. {$endif GDB}
  4477.       end;
  4478.  
  4479. {**************************************
  4480.               TSTRINGDEF
  4481.  **************************************}
  4482.  
  4483.     constructor tstringdef.init(l : byte);
  4484.  
  4485.       begin
  4486.          tdef.init;
  4487.          string_typ:=shortstring;
  4488.          deftype:=stringdef;
  4489.          len:=l;
  4490.          savesize:=len+1;
  4491.       end;
  4492.  
  4493.     constructor tstringdef.load;
  4494.  
  4495.       begin
  4496. {$ifdef GDB}
  4497.          tdef.load;
  4498.          string_typ:=shortstring;
  4499.          set_globalnb;
  4500. {$endif GDB}
  4501.          deftype:=stringdef;
  4502.          len:=readbyte;
  4503.          savesize:=len+1;
  4504.       end;
  4505.  
  4506. {$ifdef UseLongString}
  4507.     constructor tstringdef.longinit(l : longint);
  4508.  
  4509.       begin
  4510.          tdef.init;
  4511.          string_typ:=longstring;
  4512.          deftype:=stringdef;
  4513.          len:=l;
  4514.          savesize:=len+5;
  4515.       end;
  4516.  
  4517.     constructor tstringdef.longload;
  4518.  
  4519.       begin
  4520. {$ifdef GDB}
  4521.          tdef.load;
  4522.          set_globalnb;
  4523. {$endif GDB}
  4524.          deftype:=stringdef;
  4525.          string_typ:=longstring;
  4526.          len:=readlong;
  4527.          savesize:=len+5;
  4528.       end;
  4529. {$endif UseLongString}
  4530.  
  4531. {$ifdef UseAnsiString}
  4532.     constructor tstringdef.ansiinit(l : longint);
  4533.  
  4534.       begin
  4535.          tdef.init;
  4536.          string_typ:=ansistring;
  4537.          deftype:=stringdef;
  4538.          len:=l;
  4539.          savesize:=len+13;
  4540.       end;
  4541.  
  4542.     constructor tstringdef.ansiload;
  4543.  
  4544.       begin
  4545. {$ifdef GDB}
  4546.          tdef.load;
  4547.          set_globalnb;
  4548. {$endif GDB}
  4549.          deftype:=stringdef;
  4550.          string_typ:=ansistring;
  4551.          len:=readlong;
  4552.          savesize:=len+13;
  4553.       end;
  4554. {$endif UseAnsiString}
  4555.  
  4556.     function tstringdef.size : longint;
  4557.  
  4558.       begin
  4559.            size:=len+1;
  4560.       end;
  4561.  
  4562.     procedure tstringdef.write;
  4563.  
  4564.       begin
  4565.          case string_typ of
  4566.            shortstring : ppufile.write_byte(ibstringdef);
  4567. {$ifdef UseLongString}
  4568.            longstring : ppufile.write_byte(iblongstringdef);
  4569. {$endif UseLongString}
  4570. {$ifdef UseAnsiString}
  4571.            ansistring : ppufile.write_byte(ibansistringdef);
  4572. {$endif UseAnsiString}
  4573.          end;
  4574.          tdef.write;
  4575.          if string_typ=shortstring then
  4576.            ppufile.write_byte(len)
  4577.          else
  4578.            ppufile.write_long(len);
  4579.       end;
  4580.  
  4581. {$ifdef GDB}
  4582.     function tstringdef.stabstring : pchar;
  4583.  
  4584.       var bytest,charst,longst : string;
  4585.  
  4586.       begin
  4587.          if string_typ=shortstring then
  4588.            begin
  4589.               charst := typeglobalnumber('char');
  4590.               { this is what I found in stabs.texinfo but
  4591.               gdb 4.12 for go32 doesn't understand that !! }
  4592.               {$IfDef GDBknowsstrings}
  4593.               stabstring := strpnew('n'+charst+';'+tostr(len));
  4594.               {$else}
  4595.               bytest := typeglobalnumber('byte');
  4596.               stabstring := strpnew('s'+tostr(len+1)+'length:'+bytest
  4597.                 +',0,8;st:ar'+bytest
  4598.                 +';1;'+tostr(len)+';'+charst+',8,'+tostr(len*8)+';;');
  4599.               {$EndIf}
  4600.            end
  4601. {$ifdef UseLongString}
  4602.          else if string_typ=longstring then
  4603.            begin
  4604.               charst := typeglobalnumber('char');
  4605.               { this is what I found in stabs.texinfo but
  4606.               gdb 4.12 for go32 doesn't understand that !! }
  4607.               {$IfDef GDBknowsstrings}
  4608.               stabstring := strpnew('n'+charst+';'+tostr(len));
  4609.               {$else}
  4610.               bytest := typeglobalnumber('byte');
  4611.               longst := typeglobalnumber('longint');
  4612.               stabstring := strpnew('s'+tostr(len+5)+'length:'+longst
  4613.                             +',0,32;dummy:'+bytest+',32,8;st:ar'+bytest
  4614.                             +';1;'+tostr(len)+';'+charst+',40,'+tostr(len*8)+';;');
  4615.               {$EndIf}
  4616.            end
  4617. {$endif UseLongString}
  4618. {$ifdef UseAnsiString}
  4619.          else if string_typ=ansistring then
  4620.            begin
  4621.               { an ansi string looks like a pchar easy !! }
  4622.               stabstring:=strpnew('*'+typeglobalnumber('char'));
  4623.            end
  4624. {$endif UseAnsiString}
  4625.     end;
  4626.  
  4627.     procedure tstringdef.concatstabto(asmlist : paasmoutput);
  4628.       begin
  4629.         inherited concatstabto(asmlist);
  4630.       end;
  4631. {$endif GDB}
  4632.  
  4633. {**************************************
  4634.              tenumdef
  4635.  **************************************}
  4636.  
  4637.     constructor tenumdef.init;
  4638.  
  4639.       begin
  4640.          tdef.init;
  4641.          deftype:=enumdef;
  4642.          max:=0;
  4643.          savesize:=4;
  4644.          has_jumps:=false;
  4645. {$ifdef GDB}
  4646.          first := Nil;
  4647. {$endif GDB}
  4648.       end;
  4649.  
  4650.     constructor tenumdef.load;
  4651.  
  4652.       begin
  4653. {$ifdef GDB}
  4654.          tdef.load;
  4655.          set_globalnb;
  4656. {$endif GDB}
  4657.          deftype:=enumdef;
  4658.          max:=readlong;
  4659.          savesize:=4;
  4660.          has_jumps:=false;
  4661.          first := Nil;
  4662.       end;
  4663.  
  4664.     destructor tenumdef.done;
  4665.       begin
  4666.       inherited done;
  4667.       end;
  4668.  
  4669.     procedure tenumdef.write;
  4670.  
  4671.       begin
  4672.          ppufile.write_byte(ibenumdef);
  4673.          tdef.write;
  4674.          ppufile.write_long(max);
  4675. {$ifdef GDB}
  4676.       end;
  4677.  
  4678.     function tenumdef.stabstring : pchar;
  4679.       var st,st2 : pchar;
  4680.           p : penumsym;
  4681.           s : string;
  4682.           memsize : word;
  4683.       begin
  4684.       memsize := memsizeinc;
  4685.       getmem(st,memsize);
  4686.       strpcopy(st,'e');
  4687.       p := first;
  4688.       while assigned(p) do
  4689.         begin
  4690.         s :=p^.name+':'+tostr(p^.value)+',';
  4691.         { place for the ending ';' also }
  4692.         if (strlen(st)+length(s)+1<memsize) then
  4693.           strpcopy(strend(st),s)
  4694.           else
  4695.           begin
  4696.           getmem(st2,memsize+memsizeinc);
  4697.           strcopy(st2,st);
  4698.           freemem(st,memsize);
  4699.           st := st2;
  4700.           memsize := memsize+memsizeinc;
  4701.           strpcopy(strend(st),s);
  4702.           end;
  4703.         p := p^.next;
  4704.         end;
  4705.       strpcopy(strend(st),';');
  4706.       stabstring := strnew(st);
  4707.       freemem(st,memsize);
  4708. {$endif GDB}
  4709.       end;
  4710.  
  4711. {**************************************
  4712.                TORDDEF
  4713.  **************************************}
  4714.  
  4715.     constructor torddef.init(t : tbasetype;v,b : longint);
  4716.  
  4717.       begin
  4718.          tdef.init;
  4719.          deftype:=orddef;
  4720.          von:=v;
  4721.          bis:=b;
  4722.          typ:=t;
  4723.          setsize;
  4724.       end;
  4725.  
  4726.     constructor torddef.load;
  4727.  
  4728.       begin
  4729. {$ifdef GDB}
  4730.          tdef.load;
  4731.          set_globalnb;
  4732. {$endif GDB}
  4733.          deftype:=orddef;
  4734.          typ:=tbasetype(readbyte);
  4735.          von:=readlong;
  4736.          bis:=readlong;
  4737.          rangenr:=0;
  4738.          setsize;
  4739.       end;
  4740.  
  4741.     procedure torddef.setsize;
  4742.  
  4743.       begin
  4744.          if typ=uauto then
  4745.            begin
  4746.               { generate a unsigned range if bis<0 and von>=0 }
  4747.               if (von>=0) and (bis<0) then
  4748.                 begin
  4749.                    savesize:=4;
  4750.                    typ:=u32bit;
  4751.                 end
  4752.               else if (von>=0) and (bis<=255) then
  4753.                 begin
  4754.                    savesize:=1;
  4755.                    typ:=u8bit;
  4756.                 end
  4757.               else if (von>=-128) and (bis<=127) then
  4758.                 begin
  4759.                    savesize:=1;
  4760.                    typ:=s8bit;
  4761.                 end
  4762.               else if (von>=0) and (bis<=65536) then
  4763.                 begin
  4764.                    savesize:=2;
  4765.                    typ:=u16bit;
  4766.                 end
  4767.               else if (von>=-32768) and (bis<=32767) then
  4768.                 begin
  4769.                    savesize:=2;
  4770.                    typ:=s16bit;
  4771.                 end
  4772.               else
  4773.                 begin
  4774.                    savesize:=4;
  4775.                    typ:=s32bit;
  4776.                 end;
  4777.            end
  4778.          else
  4779.            case typ of
  4780.               uchar,u8bit,bool8bit,s8bit : savesize:=1;
  4781.               u16bit,s16bit : savesize:=2;
  4782.               s32bit,u32bit : savesize:=4;
  4783.               else savesize:=0;
  4784.            end;
  4785.  
  4786.          { there are no entrys for range checking }
  4787.          rangenr:=0;
  4788.       end;
  4789.  
  4790.     procedure torddef.genrangecheck;
  4791.  
  4792.       var
  4793.          name : string;
  4794.  
  4795.       begin
  4796.          if rangenr=0 then
  4797.            begin
  4798.               { generate two constant for bounds }
  4799.               getlabelnr(rangenr);
  4800. {$ifndef MAKELIB}
  4801.               name:='R_'+tostr(rangenr);
  4802. {$else MAKELIB}
  4803.               name:='R_'+current_module^.mainsource^+tostr(rangenr);
  4804. {$endif MAKELIB}
  4805.               { if we are in the interface on a unit this must be global }
  4806.               { and the name must be unique }
  4807. {$ifndef MAKELIB}
  4808.               datasegment^.concat(new(pai_symbol,init(name)));
  4809. {$else MAKELIB}
  4810.               datasegment^.concat(new(pai_symbol,init_global(name)));
  4811. {$endif MAKELIB}
  4812.               if von<=bis then
  4813.                 begin
  4814.                    datasegment^.concat(new(pai_const,init_32bit(von)));
  4815.                    datasegment^.concat(new(pai_const,init_32bit(bis)));
  4816.                 end
  4817.               { for u32bit we need two bounds }
  4818.               else
  4819.                 begin
  4820.                    datasegment^.concat(new(pai_const,init_32bit(von)));
  4821.                    datasegment^.concat(new(pai_const,init_32bit($7fffffff)));
  4822.                    inc(nextlabelnr);
  4823. {$ifndef MAKELIB}
  4824.                    name:='R_'+tostr(rangenr+1);
  4825. {$else MAKELIB}
  4826.                    name:='R_'+current_module^.unitname^+tostr(rangenr+1);
  4827. {$endif MAKELIB}
  4828.                    { if we are in the interface on a unit this must be global }
  4829.                    { and the name must be unique }
  4830. {$ifndef MAKELIB}
  4831.                    datasegment^.concat(new(pai_symbol,init(name)));
  4832. {$else MAKELIB}
  4833.                    datasegment^.concat(new(pai_symbol,init_global(name)));
  4834. {$endif MAKELIB}
  4835.                    datasegment^.concat(new(pai_const,init_32bit($80000000)));
  4836.                    datasegment^.concat(new(pai_const,init_32bit(bis)));
  4837.                 end;
  4838.            end;
  4839.       end;
  4840.  
  4841.     procedure torddef.write;
  4842.  
  4843.       begin
  4844.          ppufile.write_byte(iborddef);
  4845.          tdef.write;
  4846.          ppufile.write_byte(byte(typ));
  4847.          ppufile.write_long(von);
  4848.          ppufile.write_long(bis);
  4849.       end;
  4850.  
  4851. {$ifdef GDB}
  4852.     function torddef.stabstring : pchar;
  4853.  
  4854.       begin
  4855.       case typ of
  4856.          uvoid : stabstring := strpnew(numberstring+';');
  4857.          {GDB 4.12 for go32 doesn't like boolean as range for 0 to 1 !!!}
  4858.          bool8bit : stabstring := strpnew('r'+numberstring+';0;255;');
  4859.          { u32bit : stabstring := strpnew('r'+
  4860.               s32bitdef^.numberstring+';0;-1;'); }
  4861.          else stabstring := strpnew('r'+s32bitdef^.numberstring+';'
  4862.                             +tostr(von)+';'+tostr(bis)+';');
  4863.          end;
  4864.       end;
  4865.  
  4866. {$endif GDB}
  4867.  
  4868. {**************************************
  4869.                TFLOATDEF
  4870.  **************************************}
  4871.  
  4872.     constructor tfloatdef.init(t : tfloattype);
  4873.  
  4874.       begin
  4875.          tdef.init;
  4876.          deftype:=floatdef;
  4877.          typ:=t;
  4878.          setsize;
  4879.       end;
  4880.  
  4881.     constructor tfloatdef.load;
  4882.  
  4883.       begin
  4884. {$ifdef GDB}
  4885.          tdef.load;
  4886.          set_globalnb;
  4887. {$endif GDB}
  4888.          deftype:=floatdef;
  4889.          typ:=tfloattype(readbyte);
  4890.          setsize;
  4891.       end;
  4892.  
  4893.     procedure tfloatdef.setsize;
  4894.  
  4895.       begin
  4896.          case typ of
  4897.             f16bit:
  4898.               savesize:=2;
  4899.             f32bit,s32real:
  4900.               savesize:=4;
  4901.             s64real:
  4902.               savesize:=8;
  4903.             s64bit:
  4904.               savesize:=8;
  4905.             s80real:
  4906.               savesize:=extended_size;
  4907.             else savesize:=0;
  4908.          end;
  4909.       end;
  4910.  
  4911.     procedure tfloatdef.write;
  4912.  
  4913.       begin
  4914.          ppufile.write_byte(ibfloatdef);
  4915.          tdef.write;
  4916.          ppufile.write_byte(byte(typ));
  4917.       end;
  4918.  
  4919. {$ifdef GDB}
  4920.     function tfloatdef.stabstring : pchar;
  4921.  
  4922.       begin
  4923.          case typ of
  4924.             s32real,
  4925.             s64real : stabstring := strpnew('r'+
  4926.                s32bitdef^.numberstring+';'+tostr(savesize)+';0;');
  4927.             { for fixed real use longint instead to be able to }
  4928.             { debug something at least                         }
  4929.             f32bit:
  4930.               stabstring := s32bitdef^.stabstring;
  4931.             f16bit:
  4932.               stabstring := strpnew('r'+s32bitdef^.numberstring+';0;'+
  4933.                 tostr($ffff)+';');
  4934.             { found this solution in stabsread.c from GDB v4.16 }
  4935.             s64bit : stabstring := strpnew('r'+
  4936.                s32bitdef^.numberstring+';-'+tostr(savesize)+';0;');
  4937. {$ifdef i386}
  4938.             { under dos at least you must give a size of twelve instead of 10 !! }
  4939.             { this is probably do to the fact that in gcc all is pushed in 4 bytes size }
  4940.             s80real : stabstring := strpnew('r'+
  4941.              s32bitdef^.numberstring+';12;0;');
  4942. {$endif i386}
  4943.             else
  4944.               internalerror(10005);
  4945.          end;
  4946.       end;
  4947.  
  4948. {$endif GDB}
  4949.  
  4950. {**************************************
  4951.                TFILEDEF
  4952.  **************************************}
  4953.  
  4954.     constructor tfiledef.init(ft : tfiletype;tas : pdef);
  4955.  
  4956.       begin
  4957.          inherited init;
  4958.          deftype:=filedef;
  4959.          filetype:=ft;
  4960.          typed_as:=tas;
  4961.          setsize;
  4962.       end;
  4963.  
  4964.     constructor tfiledef.load;
  4965.  
  4966.       begin
  4967. {$ifdef GDB}
  4968.          tdef.load;
  4969.          set_globalnb;
  4970. {$endif GDB}
  4971.          deftype:=filedef;
  4972.          filetype:=tfiletype(readbyte);
  4973.          if filetype=ft_typed then
  4974.            typed_as:=readdefref
  4975.          else
  4976.            typed_as:=nil;
  4977.          setsize;
  4978.       end;
  4979.  
  4980.     procedure tfiledef.deref;
  4981.  
  4982.       begin
  4983.          if filetype=ft_typed then
  4984.            resolvedef(typed_as);
  4985.       end;
  4986.  
  4987.     procedure tfiledef.write;
  4988.  
  4989.       begin
  4990.          ppufile.write_byte(ibfiledef);
  4991.          tdef.write;
  4992.          ppufile.write_byte(byte(filetype));
  4993.          if filetype=ft_typed then
  4994.            writedefref(typed_as);
  4995.       end;
  4996.  
  4997. {$ifdef GDB}
  4998.     function tfiledef.stabstring : pchar;
  4999.  
  5000.       var namesize : longint;
  5001.       begin
  5002.       {$IfDef GDBknowsfiles}
  5003.       case filetyp of
  5004.         ft_typed : stabstring := strpnew('d'+typed_as^.numberstring{+';'});
  5005.         ft_untyped : stabstring := strpnew('d'+voiddef^.numberstring{+';'});
  5006.         ft_text : stabstring := strpnew('d'+cchardef^.numberstring{+';'});
  5007.         end;
  5008.       {$Else }
  5009.       {based on
  5010.        filerec = record
  5011.           handle : word;
  5012.           mode : word;
  5013.           recsize : word;
  5014.           _private : array[1..26] of byte;
  5015.           userdata : array[1..16] of byte;
  5016.           name : string[79 or 255 for linux]; }
  5017.       if target_info.target=target_LINUX then
  5018.         namesize:=255
  5019.       else
  5020.         namesize:=79;
  5021.  
  5022.       stabstring := strpnew('s'+tostr(savesize)+'HANDLE:'+typeglobalnumber('word')+',0,16;'+
  5023.                       'MODE:'+typeglobalnumber('word')+',16,16;'+
  5024.                       'RECSIZE:'+typeglobalnumber('word')+',32,16;'+
  5025.                       '_PRIVATE:ar'+typeglobalnumber('word')+';1;26;'+typeglobalnumber('byte')+',36,208;'+
  5026.                       'USERDATA:ar'+typeglobalnumber('word')+';1;16;'+typeglobalnumber('byte')+',256,128;'+
  5027.                       'NAME:s'+tostr(namesize+1)+
  5028.                         'length:'+typeglobalnumber('byte')+',0,8;'+
  5029.                         'st:ar'+typeglobalnumber('word')+';1;'
  5030.                         +tostr(namesize)+';'+typeglobalnumber('char')+',8,'+tostr(8*namesize)+';;'+
  5031.                       ',384,'+tostr(8*(namesize+1))+';;');
  5032.       {$EndIf}
  5033.       end;
  5034.  
  5035.     procedure tfiledef.concatstabto(asmlist : paasmoutput);
  5036.  
  5037.       begin
  5038.       { most file defs are unnamed !!! }
  5039.       if ((sym = nil) or sym^.isusedinstab or use_dbx) and not isstabwritten then
  5040.         begin
  5041.         if assigned(typed_as) then forcestabto(asmlist,typed_as);
  5042.         inherited concatstabto(asmlist);
  5043.         end;
  5044.       end;
  5045.  
  5046. {$endif GDB}
  5047.     procedure tfiledef.setsize;
  5048.  
  5049.       begin
  5050.          case target_info.target of
  5051.             target_LINUX:
  5052.            begin
  5053.               case filetype of
  5054.                  ft_text : savesize:=432;
  5055.                  ft_typed,ft_untyped : savesize:=304;
  5056.               end;
  5057.            end;
  5058.             target_Win32 , target_AMIGA, target_MAC68k:
  5059.               begin
  5060.                  case filetype of
  5061.                     ft_text : savesize:=434;
  5062.                     ft_typed,ft_untyped : savesize:=306;
  5063.                  end;
  5064.            end
  5065.          else
  5066.            begin { os/2, dos, atari tos }
  5067.               case filetype of
  5068.                  ft_text : savesize:=256;
  5069.                  ft_typed,ft_untyped : savesize:=128;
  5070.               end;
  5071.            end;
  5072.       end;
  5073.       end;
  5074.  
  5075. {**************************************
  5076.                TPOINTERDEF
  5077.  **************************************}
  5078.  
  5079.     constructor tpointerdef.init(def : pdef);
  5080.  
  5081.       begin
  5082.          inherited init;
  5083.          deftype:=pointerdef;
  5084.          definition:=def;
  5085.          savesize:=4;
  5086.       end;
  5087.  
  5088.     constructor tpointerdef.load;
  5089.  
  5090.       begin
  5091. {$ifdef GDB}
  5092.          tdef.load;
  5093.          set_globalnb;
  5094. {$endif GDB}
  5095.          deftype:=pointerdef;
  5096.          { the real address in memory is calculated later (deref) }
  5097.          definition:=readdefref;
  5098.          savesize:=4;
  5099.       end;
  5100.  
  5101.     procedure tpointerdef.deref;
  5102.  
  5103.       begin
  5104.          resolvedef(definition);
  5105.       end;
  5106.  
  5107.     procedure tpointerdef.write;
  5108.  
  5109.       begin
  5110.          ppufile.write_byte(ibpointerdef);
  5111.          tdef.write;
  5112.          writedefref(definition);
  5113.       end;
  5114.  
  5115. {$ifdef GDB}
  5116.     function tpointerdef.stabstring : pchar;
  5117.  
  5118.       begin
  5119.       stabstring := strpnew('*'+definition^.numberstring);
  5120.       end;
  5121.  
  5122.     procedure tpointerdef.concatstabto(asmlist : paasmoutput);
  5123.       var st,nb : string;
  5124.           sym_line_no : longint;
  5125.       begin
  5126.       if ( (sym=nil) or sym^.isusedinstab or use_dbx) and not isstabwritten then
  5127.         begin
  5128.         if assigned(definition) then
  5129.           if definition^.deftype in [recorddef,objectdef] then
  5130.             begin
  5131.             isstabwritten := true;
  5132.             {to avoid infinite recursion in record with next-like fields }
  5133.             nb := definition^.numberstring;
  5134.             isstabwritten := false;
  5135.             if not definition^.isstabwritten then
  5136.               begin
  5137.               if assigned(definition^.sym) then
  5138.                 begin
  5139.                 if assigned(sym) then
  5140.                   begin
  5141.                      st := sym^.name;
  5142.                      sym_line_no:=sym^.line_no;
  5143.                   end
  5144.                 else
  5145.                   begin
  5146.                      st := ' ';
  5147.                      sym_line_no:=0;
  5148.                   end;
  5149.                 st := '"'+st+':t'+numberstring+'=*'+definition^.numberstring
  5150.                       +'=xs'+definition^.sym^.name+':",'+tostr(N_LSYM)+',0,'+tostr(sym_line_no)+',0';
  5151.                 if asmlist = debuglist then do_count_dbx := true;
  5152.                 asmlist^.concat(new(pai_stabs,init(strpnew(st))));
  5153.                 end;
  5154.               end else inherited concatstabto(asmlist);
  5155.             isstabwritten := true;
  5156.             end else
  5157.             begin
  5158.             forcestabto(asmlist,definition);
  5159.             inherited concatstabto(asmlist);
  5160.             end;
  5161.         end;
  5162.       end;
  5163.  
  5164. {$endif GDB}
  5165.  
  5166. {**************************************
  5167.                TCLASSREFDEF
  5168.  **************************************}
  5169.  
  5170.     constructor tclassrefdef.init(def : pdef);
  5171.  
  5172.       begin
  5173.          inherited init(def);
  5174.          deftype:=classrefdef;
  5175.          definition:=def;
  5176.          savesize:=4;
  5177.       end;
  5178.  
  5179.     constructor tclassrefdef.load;
  5180.  
  5181.       begin
  5182.          inherited load;
  5183.          deftype:=classrefdef;
  5184.       end;
  5185.  
  5186.     procedure tclassrefdef.write;
  5187.  
  5188.       begin
  5189.          ppufile.write_byte(ibclassrefdef);
  5190.          tdef.write;
  5191.          writedefref(definition);
  5192.       end;
  5193.  
  5194. {$ifdef GDB}
  5195.     function tclassrefdef.stabstring : pchar;
  5196.  
  5197.       begin
  5198.          stabstring:=strpnew('');
  5199.       end;
  5200.  
  5201.     procedure tclassrefdef.concatstabto(asmlist : paasmoutput);
  5202.  
  5203.       begin
  5204.       end;
  5205.  
  5206. {$endif GDB}
  5207.  
  5208. {**************************************
  5209.                TSETDEF
  5210.  **************************************}
  5211.  
  5212.     constructor tsetdef.init(s : pdef;high : longint);
  5213.  
  5214.       begin
  5215.          inherited init;
  5216.          deftype:=setdef;
  5217.          setof:=s;
  5218.          if high<32 then
  5219.            begin
  5220.               settype:=smallset;
  5221.               savesize:=4;
  5222.            end
  5223.          else
  5224.          if high<256 then
  5225.            begin
  5226.               settype:=normset;
  5227.               savesize:=32;
  5228.            end
  5229.          else
  5230. {$ifdef testvarsets}
  5231.          if high<$10000 then
  5232.            begin
  5233.               settype:=varset;
  5234.               savesize:=4*((high+31) div 32);
  5235.            end
  5236.          else
  5237. {$endif testvarsets}
  5238.           Message(sym_e_ill_type_decl_set);
  5239.       end;
  5240.  
  5241.     constructor tsetdef.load;
  5242.  
  5243.       begin
  5244. {$ifdef GDB}
  5245.          tdef.load;
  5246.          set_globalnb;
  5247. {$endif GDB}
  5248.          deftype:=setdef;
  5249.          setof:=readdefref;
  5250.          settype:=tsettype(readbyte);
  5251.          case settype of
  5252.             normset : savesize:=32;
  5253.             varset : savesize:=readlong;
  5254.             smallset : savesize:=4;
  5255.          end;
  5256.       end;
  5257.  
  5258.     procedure tsetdef.write;
  5259.  
  5260.       begin
  5261.          ppufile.write_byte(ibsetdef);
  5262.          tdef.write;
  5263.          writedefref(setof);
  5264.          ppufile.write_byte(byte(settype));
  5265.          if settype=varset then
  5266.            ppufile.write_long(savesize);
  5267.       end;
  5268.  
  5269. {$ifdef GDB}
  5270.     function tsetdef.stabstring : pchar;
  5271.  
  5272.       begin
  5273.          stabstring := strpnew('S'+setof^.numberstring);
  5274.       end;
  5275.  
  5276.     procedure tsetdef.concatstabto(asmlist : paasmoutput);
  5277.  
  5278.       begin
  5279.       if ( not assigned(sym) or sym^.isusedinstab or use_dbx)
  5280.  and not isstabwritten then
  5281.         begin
  5282.         if assigned(setof) then forcestabto(asmlist,setof);
  5283.         inherited concatstabto(asmlist);
  5284.         end;
  5285.       end;
  5286.  
  5287. {$endif GDB}
  5288.     procedure tsetdef.deref;
  5289.  
  5290.       begin
  5291.          resolvedef(setof);
  5292.       end;
  5293.  
  5294. {**************************************
  5295.                TFORMALDEF
  5296.  **************************************}
  5297.  
  5298.     constructor tformaldef.init;
  5299.  
  5300.       begin
  5301.          inherited init;
  5302.          deftype:=formaldef;
  5303.          savesize:=4;
  5304.       end;
  5305.  
  5306.     constructor tformaldef.load;
  5307.  
  5308.       begin
  5309. {$ifdef GDB}
  5310.          tdef.load;
  5311. {$endif GDB}
  5312.          deftype:=formaldef;
  5313.          savesize:=4;
  5314.       end;
  5315.  
  5316.     procedure tformaldef.write;
  5317.  
  5318.       begin
  5319.          ppufile.write_byte(ibformaldef);
  5320.          tdef.write;
  5321.       end;
  5322.  
  5323. {$ifdef GDB}
  5324.     function tformaldef.stabstring : pchar;
  5325.  
  5326.       begin
  5327.       stabstring := strpnew('formal'+numberstring+';');
  5328.       end;
  5329.  
  5330.  
  5331.     procedure tformaldef.concatstabto(asmlist : paasmoutput);
  5332.  
  5333.       begin
  5334.       { formaldef can't be stab'ed !}
  5335.       end;
  5336. {$endif GDB}
  5337.  
  5338. {**************************************
  5339.                TARRAYDEF
  5340.  **************************************}
  5341.  
  5342.     constructor tarraydef.init(l,h : longint;rd : pdef);
  5343.  
  5344.       begin
  5345.          tdef.init;
  5346.          deftype:=arraydef;
  5347.          lowrange:=l;
  5348.          highrange:=h;
  5349.          rangedef:=rd;
  5350.          rangenr:=0;
  5351.          definition:=nil;
  5352.       end;
  5353.  
  5354.     constructor tarraydef.load;
  5355.  
  5356.       begin
  5357. {$ifdef GDB}
  5358.          tdef.load;
  5359.          set_globalnb;
  5360. {$endif GDB}
  5361.          deftype:=arraydef;
  5362.          { die Adressen werden sp„ter berechnet }
  5363.          definition:=readdefref;
  5364.          rangedef:=readdefref;
  5365.          lowrange:=readlong;
  5366.          highrange:=readlong;
  5367.          rangenr:=0;
  5368.       end;
  5369.  
  5370.     procedure tarraydef.genrangecheck;
  5371.  
  5372.       begin
  5373.          if rangenr=0 then
  5374.            begin
  5375.               { generates the data for range checking }
  5376.               getlabelnr(rangenr);
  5377.               datasegment^.concat(new(pai_symbol,init('R_'+tostr(rangenr))));
  5378.               datasegment^.concat(new(pai_const,init_32bit(lowrange)));
  5379.               datasegment^.concat(new(pai_const,init_32bit(highrange)));
  5380.            end;
  5381.       end;
  5382.  
  5383.     procedure tarraydef.deref;
  5384.  
  5385.       begin
  5386.          resolvedef(definition);
  5387.          resolvedef(rangedef);
  5388.       end;
  5389.  
  5390.     procedure tarraydef.write;
  5391.  
  5392.       begin
  5393.          ppufile.write_byte(ibarraydef);
  5394.          tdef.write;
  5395.          writedefref(definition);
  5396.          writedefref(rangedef);
  5397.          ppufile.write_long(lowrange);
  5398.          ppufile.write_long(highrange);
  5399.       end;
  5400.  
  5401. {$ifdef GDB}
  5402.     function tarraydef.stabstring : pchar;
  5403.       begin
  5404.       stabstring := strpnew('ar'+rangedef^.numberstring+';'
  5405.                     +tostr(lowrange)+';'+tostr(highrange)+';'+definition^.numberstring);
  5406.       end;
  5407.  
  5408.     procedure tarraydef.concatstabto(asmlist : paasmoutput);
  5409.  
  5410.       begin
  5411.       if (not assigned(sym) or sym^.isusedinstab or use_dbx)
  5412.         and not isstabwritten then
  5413.         begin
  5414.         {when array are inserted they have no definition yet !!}
  5415.         if assigned(definition) then
  5416.           inherited concatstabto(asmlist);
  5417.         end;
  5418.       end;
  5419.  
  5420. {$endif GDB}
  5421.     function tarraydef.elesize : longint;
  5422.  
  5423.       begin
  5424.          elesize:=definition^.size;
  5425.       end;
  5426.  
  5427.     function tarraydef.size : longint;
  5428.  
  5429.       begin
  5430.          size:=(highrange-lowrange+1)*elesize;
  5431.       end;
  5432.  
  5433. {**************************************
  5434.                TRECDEF
  5435.  **************************************}
  5436.  
  5437.     constructor trecdef.init(p : psymtable);
  5438.  
  5439.       begin
  5440.          tdef.init;
  5441.          deftype:=recorddef;
  5442.          symtable:=p;
  5443.          savesize:=symtable^.datasize;
  5444.          symtable^.defowner := @self;
  5445.       end;
  5446.  
  5447.     constructor trecdef.load;
  5448.  
  5449.       var
  5450.          oldread_member : boolean;
  5451.  
  5452.       begin
  5453. {$ifdef GDB}
  5454.          tdef.load;
  5455.          set_globalnb;
  5456. {$endif GDB}
  5457.          deftype:=recorddef;
  5458.          savesize:=readlong;
  5459.          oldread_member:=read_member;
  5460.          read_member:=true;
  5461.          symtable:=new(psymtable,loadasstruct(recordsymtable));
  5462.          read_member:=oldread_member;
  5463.          symtable^.defowner := @self;
  5464.       end;
  5465.  
  5466.     destructor trecdef.done;
  5467.  
  5468.       begin
  5469. {$ifndef GDB}
  5470.          dispose(symtable);
  5471. {$else GDB}
  5472.          if assigned(symtable) then dispose(symtable,done);
  5473.          inherited done;
  5474. {$endif GDB}
  5475.       end;
  5476.  
  5477.     procedure trecdef.deref;
  5478.  
  5479.       var
  5480.          hp : pdef;
  5481.          oldrecsyms : psymtable;
  5482.  
  5483.       begin
  5484.          oldrecsyms:=aktrecordsymtable;
  5485.          aktrecordsymtable:=symtable;
  5486.          { now dereference the definitions }
  5487.          hp:=symtable^.wurzeldef;
  5488.          while assigned(hp) do
  5489.            begin
  5490.               hp^.deref;
  5491.  
  5492.               { set owner }
  5493.               hp^.owner:=symtable;
  5494.  
  5495.               hp:=hp^.next;
  5496.            end;
  5497. {$ifdef tp}
  5498.          symtable^.foreach(derefsym);
  5499. {$else}
  5500.          symtable^.foreach(@derefsym);
  5501. {$endif}
  5502.          aktrecordsymtable:=oldrecsyms;
  5503.       end;
  5504.  
  5505.     procedure trecdef.write;
  5506.  
  5507.       var
  5508.          oldread_member : boolean;
  5509.  
  5510.       begin
  5511.          oldread_member:=read_member;
  5512.          read_member:=true;
  5513.          ppufile.write_byte(ibrecorddef);
  5514.          tdef.write;
  5515.          ppufile.write_long(savesize);
  5516.          self.symtable^.writeasstruct;
  5517.          read_member:=oldread_member;
  5518.       end;
  5519.  
  5520. {$ifdef GDB}
  5521.  
  5522.       Const StabRecString : pchar = Nil;
  5523.             StabRecSize : longint = 0;
  5524.           RecOffset : Longint = 0;
  5525.  
  5526.     procedure addname(p : psym);
  5527.  
  5528.       var news, newrec : pchar;
  5529.     begin
  5530.     { static variables from objects are like global objects }
  5531.     if ((p^.properties and sp_static)<>0) then
  5532.       exit;
  5533.     If p^.typ = varsym then
  5534.        begin
  5535.        newrec := strpnew(p^.name+':'+pvarsym(p)^.definition^.numberstring
  5536.                      +','+tostr(pvarsym(p)^.address*8)+','
  5537.                      +tostr(pvarsym(p)^.definition^.size*8)+';');
  5538.        if strlen(StabRecString) + strlen(newrec) >= StabRecSize-256 then
  5539.          begin
  5540.             getmem(news,stabrecsize+memsizeinc);
  5541.             strcopy(news,stabrecstring);
  5542.             freemem(stabrecstring,stabrecsize);
  5543.             stabrecsize:=stabrecsize+memsizeinc;
  5544.             stabrecstring:=news;
  5545.          end;
  5546.        strcat(StabRecstring,newrec);
  5547.        strdispose(newrec);
  5548.        {This should be used for case !!}
  5549.        RecOffset := RecOffset + pvarsym(p)^.definition^.size;
  5550.        end;
  5551.     end;
  5552.  
  5553.     function trecdef.stabstring : pchar;
  5554.       Var oldrec : pchar;
  5555.           oldsize : longint;
  5556.  
  5557.  
  5558.       begin
  5559.       oldrec := stabrecstring;
  5560.       oldsize:=stabrecsize;
  5561.       GetMem(stabrecstring,memsizeinc);
  5562.       stabrecsize:=memsizeinc;
  5563.       strpcopy(stabRecString,'s'+tostr(savesize));
  5564.       RecOffset := 0;
  5565. {$ifdef tp}
  5566.       symtable^.foreach(addname);
  5567. {$else}
  5568.       symtable^.foreach(@addname);
  5569. {$endif}
  5570.       { FPC doesn't want to convert a char to a pchar}
  5571.       { is this a bug ? }
  5572.       strpcopy(strend(StabRecString),';');
  5573.       stabstring := strnew(StabRecString);
  5574.       Freemem(stabrecstring,stabrecsize);
  5575.       stabrecstring := oldrec;
  5576.       stabrecsize:=oldsize;
  5577.       end;
  5578.  
  5579.     procedure trecdef.concatstabto(asmlist : paasmoutput);
  5580.  
  5581.       begin
  5582.       if ( not assigned(sym) or sym^.isusedinstab or use_dbx)
  5583.       and not isstabwritten then
  5584.         begin
  5585.         inherited concatstabto(asmlist);
  5586.         end;
  5587.       end;
  5588.  
  5589. {$endif GDB}
  5590.  
  5591. {**************************************
  5592.                TABSTRACTPROCDEF
  5593.  **************************************}
  5594.  
  5595.     constructor tabstractprocdef.init;
  5596.  
  5597.       begin
  5598.          inherited init;
  5599.          para1:=nil;
  5600.          options:=0;
  5601.          retdef:=voiddef;
  5602.          savesize:=4;
  5603.       end;
  5604.  
  5605.     destructor tabstractprocdef.done;
  5606.  
  5607.       var
  5608.          hp : pdefcoll;
  5609.  
  5610.       begin
  5611.          hp:=para1;
  5612.          while assigned(hp) do
  5613.            begin
  5614.               para1:=hp^.next;
  5615.               dispose(hp);
  5616.               hp:=para1;
  5617.            end;
  5618.          inherited done;
  5619.       end;
  5620.  
  5621.     procedure tabstractprocdef.concatdef(p : pdef;vsp : tvarspez);
  5622.  
  5623.       var
  5624.          hp : pdefcoll;
  5625.  
  5626.       begin
  5627.          new(hp);
  5628.          hp^.paratyp:=vsp;
  5629.          hp^.data:=p;
  5630.          hp^.next:=para1;
  5631.          para1:=hp;
  5632.       end;
  5633.  
  5634.     procedure tabstractprocdef.deref;
  5635.  
  5636.       var
  5637.          hp : pdefcoll;
  5638.  
  5639.       begin
  5640.          inherited deref;
  5641.          resolvedef(retdef);
  5642.          hp:=para1;
  5643.          while assigned(hp) do
  5644.            begin
  5645.               resolvedef(hp^.data);
  5646.               hp:=hp^.next;
  5647.            end;
  5648.       end;
  5649.  
  5650.     constructor tabstractprocdef.load;
  5651.  
  5652.       var
  5653.          last,hp : pdefcoll;
  5654.          count,i : word;
  5655.  
  5656.       begin
  5657. {$ifdef GDB}
  5658.          tdef.load;
  5659. {$endif GDB}
  5660.          retdef:=readdefref;
  5661.          options:=readlong;
  5662.          count:=readword;
  5663.          para1:=nil;
  5664.          savesize:=4;
  5665.          for i:=1 to count do
  5666.            begin
  5667.               new(hp);
  5668.               hp^.paratyp:=tvarspez(readbyte);
  5669.               hp^.data:=readdefref;
  5670.               hp^.next:=nil;
  5671.               if para1=nil then
  5672.                 para1:=hp
  5673.               else
  5674.                 last^.next:=hp;
  5675.               last:=hp;
  5676.            end;
  5677.       end;
  5678.  
  5679.     procedure tabstractprocdef.write;
  5680.  
  5681.       var
  5682.          count : word;
  5683.          hp : pdefcoll;
  5684.  
  5685.       begin
  5686.          tdef.write;
  5687.          writedefref(retdef);
  5688.          ppufile.write_long(options);
  5689.          hp:=para1;
  5690.          count:=0;
  5691.          while assigned(hp) do
  5692.            begin
  5693.               inc(count);
  5694.               hp:=hp^.next;
  5695.            end;
  5696.          ppufile.write_word(count);
  5697.          hp:=para1;
  5698.          while assigned(hp) do
  5699.            begin
  5700.               ppufile.write_byte(byte(hp^.paratyp));
  5701.               writedefref(hp^.data);
  5702.               hp:=hp^.next;
  5703.            end;
  5704.       end;
  5705.  
  5706. {$ifdef GDB}
  5707.     function tabstractprocdef.stabstring : pchar;
  5708.       begin
  5709.       stabstring := strpnew('abstractproc'+numberstring+';');
  5710.       end;
  5711.  
  5712.     procedure tabstractprocdef.concatstabto(asmlist : paasmoutput);
  5713.  
  5714.       begin
  5715.          if (not assigned(sym) or sym^.isusedinstab or use_dbx)
  5716.             and not isstabwritten then
  5717.            begin
  5718.               {if assigned(retdef) then forcestabto(asmlist,retdef);}
  5719.               inherited concatstabto(asmlist);
  5720.            end;
  5721.       end;
  5722.  
  5723. {$endif GDB}
  5724.  
  5725. {**************************************
  5726.                TPROCDEF
  5727.  **************************************}
  5728.  
  5729.     constructor tprocdef.init;
  5730.  
  5731.       begin
  5732.          inherited init;
  5733.          deftype:=procdef;
  5734.          _mangledname:=nil;
  5735.          nextoverloaded:=nil;
  5736.          extnumber:=-1;
  5737. {$ifndef GDB}
  5738.          parast:=new(psymtable,init(parasymtable));
  5739. {$endif * not GDB *}
  5740.          localst:=new(psymtable,init(localsymtable));
  5741. {$ifdef GDB}
  5742.          parast:=new(psymtable,init(parasymtable));
  5743. {$endif GDB}
  5744.  
  5745. {$ifdef UseBrowser}
  5746.          defref:=nil;
  5747.          add_new_ref(defref);
  5748.          lastref:=defref;
  5749.          lastwritten:=nil;
  5750.          refcount:=1;
  5751. {$endif UseBrowser}
  5752.  
  5753.          { first, we assume, that all registers are used }
  5754. {$ifdef i386}
  5755.          usedregisters:=$ff;
  5756. {$endif i386}
  5757. {$ifdef m68k}
  5758.          usedregisters:=$FFFF;
  5759. {$endif}
  5760. {$ifdef alpha}
  5761.          usedregisters_int:=$ffffffff;
  5762.          usedregisters_fpu:=$ffffffff;
  5763. {$endif alpha}
  5764.          forwarddef:=true;
  5765.          _class := nil;
  5766.       end;
  5767.  
  5768.     constructor tprocdef.load;
  5769.  
  5770.       var
  5771.          s : string;
  5772.  
  5773.       begin
  5774.          deftype:=procdef;
  5775.          inherited load;
  5776. {$ifdef i386}
  5777.          usedregisters:=readbyte;
  5778. {$endif i386}
  5779. {$ifdef m68k}
  5780.          usedregisters:=readword;
  5781. {$endif}
  5782. {$ifdef alpha}
  5783.          usedregisters_int:=readlong;
  5784.          usedregisters_fpu:=readlong;
  5785. {$endif alpha}
  5786.  
  5787.          s:=readstring;
  5788.          setstring(_mangledname,s);
  5789.  
  5790.          extnumber:=readlong;
  5791.          nextoverloaded:=pprocdef(readdefref);
  5792. { this $ifdef GDB made the ppu files different !! }
  5793.          _class := pobjectdef(readdefref);
  5794.  
  5795.         if gendeffile and ((options and poexports)<>0) then
  5796.            writeln(deffile,#9+mangledname);
  5797.  
  5798.          parast:=nil;
  5799.          localst:=nil;
  5800.          forwarddef:=false;
  5801. {$ifdef UseBrowser}
  5802.          if (current_module^.flags and uf_uses_browser)<>0 then
  5803.            load_references
  5804.          else
  5805.            begin
  5806.               lastref:=nil;
  5807.               lastwritten:=nil;
  5808.               defref:=nil;
  5809.               refcount:=0;
  5810.            end;
  5811. {$endif UseBrowser}
  5812.       end;
  5813.  
  5814. {$ifdef UseBrowser}
  5815.     procedure tprocdef.load_references;
  5816.  
  5817.       var fileindex : word;
  5818.           b : byte;
  5819.           l : longint;
  5820.  
  5821.       begin
  5822.          b:=readbyte;
  5823.          refcount:=0;
  5824.          lastref:=nil;
  5825.          lastwritten:=nil;
  5826.          defref:=nil;
  5827.          while b=ibref do
  5828.            begin
  5829.               fileindex:=readword;
  5830.               l:=readlong;
  5831.               inc(refcount);
  5832.               lastref:=new(pref,load(lastref,fileindex,l));
  5833.               if refcount=1 then defref:=lastref;
  5834.               b:=readbyte;
  5835.            end;
  5836.          if b <> ibend then
  5837.           Message(unit_f_ppu_read);
  5838.       end;
  5839.  
  5840.     procedure tprocdef.write_references;
  5841.  
  5842.       var ref : pref;
  5843.  
  5844.       begin
  5845.       { references do not change the ppu caracteristics      }
  5846.       { this only save the references to variables/functions }
  5847.       { defined in the unit what about the others            }
  5848.          ppufile.do_crc:=false;
  5849.          if assigned(lastwritten) then
  5850.            ref:=lastwritten
  5851.          else
  5852.            ref:=defref;
  5853.          while assigned(ref) do
  5854.            begin
  5855.               writebyte(ibref);
  5856.               writeword(ref^.inputfile^.ref_index);
  5857.               writelong(ref^.lineno);
  5858.               ref:=ref^.nextref;
  5859.            end;
  5860.          lastwritten:=lastref;
  5861.          writebyte(ibend);
  5862.          ppufile.do_crc:=true;
  5863.       end;
  5864.  
  5865.     procedure tprocdef.write_external_references;
  5866.  
  5867.       var ref : pref;
  5868.  
  5869.       begin
  5870.          ppufile.do_crc:=false;
  5871.          if lastwritten=lastref then exit;
  5872.          writebyte(ibextdefref);
  5873.          writedefref(@self);
  5874.          if assigned(lastwritten) then
  5875.            ref:=lastwritten
  5876.          else
  5877.            ref:=defref;
  5878.          while assigned(ref) do
  5879.            begin
  5880.               writebyte(ibref);
  5881.               writeword(ref^.inputfile^.ref_index);
  5882.               writelong(ref^.lineno);
  5883.               ref:=ref^.nextref;
  5884.            end;
  5885.          lastwritten:=lastref;
  5886.          writebyte(ibend);
  5887.          ppufile.do_crc:=true;
  5888.       end;
  5889.  
  5890.     procedure tprocdef.write_ref_to_file(var f : text);
  5891.  
  5892.       var ref : pref;
  5893.  
  5894.       begin
  5895.          ref:=defref;
  5896.          while assigned(ref) do
  5897.            begin
  5898.               writeln(f,ref^.get_file_line);
  5899.               ref:=ref^.nextref;
  5900.            end;
  5901.       end;
  5902. {$endif UseBrowser}
  5903.  
  5904.     destructor tprocdef.done;
  5905.  
  5906.       begin
  5907.          if assigned(parast) then
  5908.            dispose(parast,done);
  5909.          if assigned(localst) then
  5910.            dispose(localst,done);
  5911.          if
  5912. {$ifdef tp}
  5913.          not(use_big) and
  5914. {$endif}
  5915.          assigned(_mangledname) then
  5916.            strdispose(_mangledname);
  5917.          inherited done;
  5918.       end;
  5919.  
  5920.     procedure tprocdef.write;
  5921.  
  5922.       begin
  5923.          ppufile.write_byte(ibprocdef);
  5924.          inherited write;
  5925. {$ifdef i386}
  5926.          ppufile.write_byte(usedregisters);
  5927. {$endif i386}
  5928. {$ifdef m68k}
  5929.          ppufile.write_word(usedregisters);
  5930. {$endif}
  5931.  
  5932. {$ifdef alpha}
  5933.          ppufile.write_long(usedregisters_int);
  5934.          ppufile.write_long(usedregisters_fpu);
  5935. {$endif alpha}
  5936.  
  5937.          writestring(mangledname);
  5938.          ppufile.write_long(extnumber);
  5939.          writedefref(nextoverloaded);
  5940.          writedefref(_class);
  5941. {$ifdef UseBrowser}
  5942.          if (current_module^.flags and uf_uses_browser)<>0 then
  5943.            write_references;
  5944. {$endif UseBrowser}
  5945.       end;
  5946.  
  5947. {$ifdef GDB}
  5948.     procedure addparaname(p : psym);
  5949.       var vs : char;
  5950.  
  5951.       begin
  5952.       if pvarsym(p)^.varspez = vs_value then vs := '1'
  5953.         else vs := '0';
  5954.       strpcopy(strend(StabRecString),p^.name+':'+pvarsym(p)^.definition^.numberstring+','+vs+';');
  5955.       end;
  5956.  
  5957.     function tprocdef.stabstring : pchar;
  5958.       var param : pdefcoll;
  5959.           i : word;
  5960.           vartyp : char;
  5961.           oldrec : pchar;
  5962.       begin
  5963.       oldrec := stabrecstring;
  5964.       getmem(StabRecString,1024);
  5965.       param := para1;
  5966.       i := 0;
  5967.       while assigned(param) do
  5968.         begin
  5969.            inc(i);
  5970.            param := param^.next;
  5971.         end;
  5972.       strpcopy(StabRecString,'f'+retdef^.numberstring);
  5973.       if i>0 then
  5974.         begin
  5975.         strpcopy(strend(StabRecString),','+tostr(i)+';');
  5976.         if assigned(parast) then
  5977.           {$IfDef TP}
  5978.           parast^.foreach(addparaname)
  5979.           {$Else}
  5980.           parast^.foreach(@addparaname)
  5981.           {$EndIf}
  5982.           else
  5983.           begin
  5984.           param := para1;
  5985.           i := 0;
  5986.           while assigned(param) do
  5987.             begin
  5988.             inc(i);
  5989.             if param^.paratyp = vs_value then vartyp := '1' else vartyp := '0';
  5990.             {Here we have lost the parameter names !!}
  5991.             {using lower case parameters }
  5992.             strpcopy(strend(stabrecstring),'p'+tostr(i)
  5993.                +':'+param^.data^.numberstring+','+vartyp+';');
  5994.             param := param^.next;
  5995.             end;
  5996.           end;
  5997.         {strpcopy(strend(StabRecString),';');}
  5998.         end;
  5999.       stabstring := strnew(stabrecstring);
  6000.       freemem(stabrecstring,1024);
  6001.       stabrecstring := oldrec;
  6002.       end;
  6003.  
  6004.     procedure tprocdef.concatstabto(asmlist : paasmoutput);
  6005.  
  6006.       begin
  6007.       end;
  6008. {$endif GDB}
  6009.  
  6010.     procedure tprocdef.deref;
  6011.  
  6012.       begin
  6013.          inherited deref;
  6014.          resolvedef(pdef(nextoverloaded));
  6015.          resolvedef(pdef(_class));
  6016.       end;
  6017.  
  6018.     function tprocdef.mangledname : string;
  6019.  
  6020. {$ifdef tp}
  6021.       var
  6022.          oldpos : longint;
  6023.          s : string;
  6024.          b : byte;
  6025. {$endif tp}
  6026.  
  6027.       begin
  6028. {$ifdef tp}
  6029.          if use_big then
  6030.            begin
  6031.               symbolstream.seek(longint(_mangledname));
  6032.               symbolstream.read(b,1);
  6033.               symbolstream.read(s[1],b);
  6034.               s[0]:=chr(b);
  6035.               mangledname:=s;
  6036.            end
  6037.          else
  6038. {$endif}
  6039.            begin
  6040.               mangledname:=strpas(_mangledname);
  6041.            end;
  6042.       end;
  6043.  
  6044. {$IfDef GDB}
  6045.     function tprocdef.cplusplusmangledname : string;
  6046.  
  6047.       var
  6048.          s,s2 : string;
  6049.          param : pdefcoll;
  6050.  
  6051.       begin
  6052.       s := sym^.name;
  6053.       if _class <> nil then
  6054.         begin
  6055.         s2 := _class^.name^;
  6056.         s := s+'__'+tostr(length(s2))+s2;
  6057.         end else s := s + '_';
  6058.       param := para1;
  6059.       while assigned(param) do
  6060.         begin
  6061.         s2 := param^.data^.sym^.name;
  6062.         s := s+tostr(length(s2))+s2;
  6063.         param := param^.next;
  6064.         end;
  6065.       cplusplusmangledname:=s;
  6066.       end;
  6067. {$EndIf GDB}
  6068.  
  6069.     procedure tprocdef.setmangledname(const s : string);
  6070.  
  6071.       begin
  6072.          if
  6073. {$ifdef tp}
  6074.          not(use_big) and
  6075. {$endif}
  6076.          (assigned(_mangledname)) then
  6077.            strdispose(_mangledname);
  6078.          setstring(_mangledname,s);
  6079.       end;
  6080.  
  6081. {**************************************
  6082.                TPROCVARDEF
  6083.  **************************************}
  6084.  
  6085.     constructor tprocvardef.init;
  6086.  
  6087.       begin
  6088.          inherited init;
  6089.          deftype:=procvardef;
  6090.       end;
  6091.  
  6092.     constructor tprocvardef.load;
  6093.  
  6094.       begin
  6095. {$ifndef GDB}
  6096.          deftype:=procvardef;
  6097. {$endif * not GDB *}
  6098.          inherited load;
  6099. {$ifdef GDB}
  6100.          deftype:=procvardef;
  6101.          set_globalnb;
  6102. {$endif GDB}
  6103.       end;
  6104.  
  6105.     procedure tprocvardef.write;
  6106.  
  6107.       begin
  6108.          ppufile.write_byte(ibprocvardef);
  6109.          inherited write;
  6110.       end;
  6111.  
  6112. {$ifdef GDB}
  6113.     function tprocvardef.stabstring : pchar;
  6114.  
  6115.       var
  6116.          nss : pchar;
  6117.          i : word;
  6118.          vartyp : char;
  6119.          pst : pchar;
  6120.          param : pdefcoll;
  6121.  
  6122.       begin
  6123.       i := 0;
  6124.       param := para1;
  6125.       while assigned(param) do
  6126.         begin
  6127.         inc(i);
  6128.         param := param^.next;
  6129.         end;
  6130.       getmem(nss,1024);
  6131.       strpcopy(nss,'f'+retdef^.numberstring+','+tostr(i)+';');
  6132.       param := para1;
  6133.       i := 0;
  6134.       while assigned(param) do
  6135.         begin
  6136.         inc(i);
  6137.         if param^.paratyp = vs_value then vartyp := '1' else vartyp := '0';
  6138.         {Here we have lost the parameter names !!}
  6139.         pst := strpnew('p'+tostr(i)+':'+param^.data^.numberstring+','+vartyp+';');
  6140.         strcat(nss,pst);
  6141.         strdispose(pst);
  6142.         param := param^.next;
  6143.         end;
  6144.       {strpcopy(strend(nss),';');}
  6145.       stabstring := strnew(nss);
  6146.       freemem(nss,1024);
  6147.       end;
  6148.  
  6149.     procedure tprocvardef.concatstabto(asmlist : paasmoutput);
  6150.  
  6151.       begin
  6152.          if ( not assigned(sym) or sym^.isusedinstab or use_dbx)
  6153.            and not isstabwritten then
  6154.            inherited concatstabto(asmlist);
  6155.          isstabwritten:=true;
  6156.       end;
  6157. {$endif GDB}
  6158.  
  6159. {**************************************
  6160.                TOBJECTDEF
  6161.  **************************************}
  6162.  
  6163. {$ifdef GDB}
  6164.     const
  6165.        vtabletype : word = 0;
  6166.        vtableassigned : boolean = false;
  6167.  
  6168. {$endif GDB}
  6169.    constructor tobjectdef.init(const n : string;c : pobjectdef);
  6170.  
  6171.      begin
  6172.         tdef.init;
  6173.         deftype:=objectdef;
  6174.         childof:=c;
  6175.         options:=0;
  6176.         { privatesyms:=new(psymtable,init(objectsymtable));
  6177.       protectedsyms:=new(psymtable,init(objectsymtable)); }
  6178.         publicsyms:=new(psymtable,init(objectsymtable));
  6179.         publicsyms^.name := stringdup(n);
  6180.         { add the data of the anchestor class }
  6181.         if assigned(childof) then
  6182.           begin
  6183.              publicsyms^.datasize:=
  6184.                publicsyms^.datasize-4+childof^.publicsyms^.datasize;
  6185.           end;
  6186.         name:=stringdup(n);
  6187.         savesize := publicsyms^.datasize;
  6188.         publicsyms^.defowner:=@self;
  6189.      end;
  6190.  
  6191.     constructor tobjectdef.load;
  6192.  
  6193.       var
  6194.          oldread_member : boolean;
  6195.  
  6196.       begin
  6197. {$ifdef GDB}
  6198.          tdef.load;
  6199.          set_globalnb;
  6200. {$endif GDB}
  6201.          deftype:=objectdef;
  6202.          savesize:=readlong;
  6203.          name:=stringdup(readstring);
  6204.  
  6205.          childof:=pobjectdef(readdefref);
  6206.          options:=readlong;
  6207.          oldread_member:=read_member;
  6208.          read_member:=true;
  6209.          if (options and (oo_hasprivate or oo_hasprotected))<>0 then
  6210.            object_options:=true;
  6211.          publicsyms:=new(psymtable,loadasstruct(objectsymtable));
  6212.          object_options:=false;
  6213.          publicsyms^.defowner:=@self;
  6214.          publicsyms^.datasize:=savesize;
  6215. {$ifdef GDB}
  6216.          publicsyms^.name := stringdup(name^);
  6217. {$endif GDB}
  6218.          read_member:=oldread_member;
  6219.  
  6220.          { handles the predefined class tobject  }
  6221.          { the last TOBJECT which is loaded gets }
  6222.          { it !                                  }
  6223.          if (name^='TOBJECT') and not(cs_compilesystem in aktswitches) and
  6224.            isclass and (childof=pointer($ffffffff)) then
  6225.            class_tobject:=@self;
  6226.       end;
  6227.  
  6228.    procedure tobjectdef.check_forwards;
  6229.  
  6230.      begin
  6231.         publicsyms^.check_forwards;
  6232.         if (options and oo_isforward)<>0 then
  6233.           begin
  6234.              { ok, in future, the forward can be resolved }
  6235.              Message1(sym_e_class_forward_not_resolved,name^);
  6236.              options:=options and not(oo_isforward);
  6237.           end;
  6238.      end;
  6239.  
  6240.    destructor tobjectdef.done;
  6241.  
  6242.      begin
  6243. {!!!!
  6244.         if assigned(privatesyms) then
  6245.           dispose(privatesyms,done);
  6246.         if assigned(protectedsyms) then
  6247.           dispose(protectedsyms,done); }
  6248.         if assigned(publicsyms) then
  6249.           dispose(publicsyms,done);
  6250.         if (options and oo_isforward)<>0 then
  6251.          Message1(sym_e_class_forward_not_resolved,name^);
  6252.         stringdispose(name);
  6253.         tdef.done;
  6254.      end;
  6255.  
  6256.    { true, if self inherits from d (or if they are equal) }
  6257.    function tobjectdef.isrelated(d : pobjectdef) : boolean;
  6258.  
  6259.      var
  6260.         hp : pobjectdef;
  6261.  
  6262.      begin
  6263.         hp:=@self;
  6264.         while assigned(hp) do
  6265.           begin
  6266.              if hp=d then
  6267.                begin
  6268.                   isrelated:=true;
  6269.                   exit;
  6270.                end;
  6271.              hp:=hp^.childof;
  6272.           end;
  6273.         isrelated:=false;
  6274.      end;
  6275.  
  6276.    function tobjectdef.size : longint;
  6277.  
  6278.      begin
  6279.         if (options and oois_class)<>0 then
  6280.           size:=4
  6281.         else
  6282.           size:=publicsyms^.datasize;
  6283.      end;
  6284.  
  6285.     procedure tobjectdef.deref;
  6286.  
  6287.       var
  6288.          hp : pdef;
  6289.          oldrecsyms : psymtable;
  6290.  
  6291.       begin
  6292.          resolvedef(pdef(childof));
  6293.          oldrecsyms:=aktrecordsymtable;
  6294.          aktrecordsymtable:=publicsyms;
  6295.          { nun die Definitionen dereferenzieren }
  6296.          hp:=publicsyms^.wurzeldef;
  6297.          while assigned(hp) do
  6298.            begin
  6299.               hp^.deref;
  6300.  
  6301.               {Besitzer setzen }
  6302.               hp^.owner:=publicsyms;
  6303.  
  6304.               hp:=hp^.next;
  6305.            end;
  6306. {$ifdef tp}
  6307.          publicsyms^.foreach(derefsym);
  6308. {$else}
  6309.          publicsyms^.foreach(@derefsym);
  6310. {$endif}
  6311.          aktrecordsymtable:=oldrecsyms;
  6312.       end;
  6313.  
  6314.     function tobjectdef.vmt_mangledname : string;
  6315.  
  6316.     {DM: I get a nil pointer on the owner name. I don't know if this
  6317.      mayhappen, and I have therefore fixed the problem by doing nil pointer
  6318.      checks.}
  6319.  
  6320.     var s1,s2:string;
  6321.  
  6322.     begin
  6323.         if owner^.name=nil then
  6324.             s1:=''
  6325.         else
  6326.             s1:=owner^.name^;
  6327.         if name=nil then
  6328.             s2:=''
  6329.         else
  6330.             s2:=name^;
  6331.         vmt_mangledname:='VMT_'+s1+'$_'+s2;
  6332.     end;
  6333.  
  6334.     function tobjectdef.isclass : boolean;
  6335.  
  6336.       begin
  6337.          isclass:=(options and oois_class)<>0;
  6338.       end;
  6339.  
  6340.     procedure tobjectdef.write;
  6341.  
  6342.       var
  6343.          oldread_member : boolean;
  6344.  
  6345.       begin
  6346.          oldread_member:=read_member;
  6347.          read_member:=true;
  6348.          ppufile.write_byte(ibobjectdef);
  6349.          tdef.write;
  6350.          ppufile.write_long(size);
  6351.          writestring(name^);
  6352.          writedefref(childof);
  6353.          ppufile.write_long(options);
  6354.          if (options and (oo_hasprivate or oo_hasprotected))<>0 then
  6355.            object_options:=true;
  6356.          publicsyms^.writeasstruct;
  6357.          object_options:=false;
  6358.          read_member:=oldread_member;
  6359.       end;
  6360.  
  6361. {$ifdef GDB}
  6362.     procedure addprocname(p :psym);
  6363.     var virtualind,argnames : string;
  6364.         news, newrec : pchar;
  6365.         pd,ipd : pprocdef;
  6366.         lindex : longint;
  6367.         para : pdefcoll;
  6368.         arglength : byte;
  6369.     begin
  6370.     If p^.typ = procsym then
  6371.        begin
  6372.                 pd := pprocsym(p)^.definition;
  6373.                 { this will be used for full implementation of object stabs
  6374.                 not yet done }
  6375.                 ipd := pd;
  6376.                 while assigned(ipd^.nextoverloaded) do ipd := ipd^.nextoverloaded;
  6377.                 if (pd^.options and povirtualmethod) <> 0 then
  6378.                    begin
  6379.                    lindex := pd^.extnumber;
  6380.                    {doesnt seem to be necessary
  6381.                    lindex := lindex or $80000000;}
  6382.                    virtualind := '*'+tostr(lindex)+';'+ipd^._class^.numberstring+';'
  6383.                    end else virtualind := '.';
  6384.                 { arguments are not listed here }
  6385.                 {we don't need another definition}
  6386.                  para := pd^.para1;
  6387.                  argnames := '';
  6388.                  while assigned(para) do
  6389.                    begin
  6390.                    if para^.data^.deftype = formaldef then
  6391.                      argnames := argnames+'3var'
  6392.                      else
  6393.                      begin
  6394.                      { if the arg definition is like (v: ^byte;..
  6395.                      there is no sym attached to data !!! }
  6396.                      if assigned(para^.data^.sym) then
  6397.                        begin
  6398.                           arglength := length(para^.data^.sym^.name);
  6399.                           argnames := argnames + tostr(arglength)+para^.data^.sym^.name;
  6400.                        end
  6401.                      else
  6402.                        begin
  6403.                           argnames:=argnames+'11unnamedtype';
  6404.                        end;
  6405.                      end;
  6406.                    para := para^.next;
  6407.                    end;
  6408.                 ipd^.isstabwritten := true;
  6409.                 { here 2A must be changed for private and protected }
  6410.                 newrec := strpnew(p^.name+'::'+ipd^.numberstring
  6411.                      +'=##'+pd^.retdef^.numberstring+';:'+argnames+';2A'
  6412.                      +virtualind+';');
  6413.                { get spare place for a string at the end }
  6414.                if strlen(StabRecString) + strlen(newrec) >= StabRecSize-256 then
  6415.                  begin
  6416.                     getmem(news,stabrecsize+memsizeinc);
  6417.                     strcopy(news,stabrecstring);
  6418.                     freemem(stabrecstring,stabrecsize);
  6419.                     stabrecsize:=stabrecsize+memsizeinc;
  6420.                     stabrecstring:=news;
  6421.                  end;
  6422.                strcat(StabRecstring,newrec);
  6423.                {freemem(newrec,memsizeinc);    }
  6424.                strdispose(newrec);
  6425.                {This should be used for case !!}
  6426.                RecOffset := RecOffset + pd^.size;
  6427.        end;
  6428.     end;
  6429.  
  6430.     function tobjectdef.stabstring : pchar;
  6431.       var anc : pobjectdef;
  6432.           oldrec : pchar;
  6433.           oldrecsize : longint;
  6434.           str_end : string;
  6435.       begin
  6436.       oldrec := stabrecstring;
  6437.       oldrecsize:=stabrecsize;
  6438.       stabrecsize:=memsizeinc;
  6439.       GetMem(stabrecstring,stabrecsize);
  6440.       strpcopy(stabRecString,'s'+tostr(size));
  6441.       if assigned(childof) then
  6442.         {only one ancestor not virtual, public, at base offset 0 }
  6443.         {       !1           ,    0       2         0    ,       }
  6444.         strpcopy(strend(stabrecstring),'!1,020,'+childof^.numberstring+';');
  6445.       {virtual table to implement yet}
  6446.       RecOffset := 0;
  6447. {$ifdef tp}
  6448.          publicsyms^.foreach(addname);
  6449. {$else}
  6450.          publicsyms^.foreach(@addname);
  6451. {$endif tp}
  6452.       if (options and oo_hasvirtual) <> 0 then
  6453.         if not assigned(childof) or ((childof^.options and oo_hasvirtual) = 0) then
  6454.            begin
  6455.               str_end:='$vf'+numberstring+':'+typeglobalnumber('vtblarray')+',0;';
  6456.               strpcopy(strend(stabrecstring),'$vf'+numberstring+':'+typeglobalnumber('vtblarray')+',0;');
  6457.            end;
  6458. {$ifdef tp}
  6459.          publicsyms^.foreach(addprocname);
  6460. {$else}
  6461.          publicsyms^.foreach(@addprocname);
  6462. {$endif tp }
  6463.       if (options and oo_hasvirtual) <> 0  then
  6464.         begin
  6465.            anc := @self;
  6466.            while assigned(anc^.childof) and ((anc^.childof^.options and oo_hasvirtual) <> 0) do
  6467.              anc := anc^.childof;
  6468.            str_end:=';~%'+anc^.numberstring+';';
  6469.         end
  6470.       else
  6471.         str_end:=';';
  6472.       strpcopy(strend(stabrecstring),str_end);
  6473.       stabstring := strnew(StabRecString);
  6474.       freemem(stabrecstring,stabrecsize);
  6475.       stabrecstring := oldrec;
  6476.       stabrecsize:=oldrecsize;
  6477.       end;
  6478.  
  6479. {$endif GDB}
  6480.  
  6481. {**************************************
  6482.                TERRORDEF
  6483.  **************************************}
  6484.  
  6485.    constructor terrordef.init;
  6486.  
  6487.      begin
  6488.         tdef.init;
  6489.         deftype:=errordef;
  6490.      end;
  6491.  
  6492. {$ifdef GDB}
  6493.     function terrordef.stabstring : pchar;
  6494.  
  6495.       begin
  6496.          stabstring:=strpnew('error'+numberstring);
  6497.       end;
  6498.  
  6499. {$endif GDB}
  6500.  
  6501.     { type helper routines for objects }
  6502.     function search_class_member(pd : pobjectdef;const n : string) : psym;
  6503.  
  6504.       var
  6505.          sym : psym;
  6506.  
  6507.       begin
  6508.          sym:=nil;
  6509.          while assigned(pd) do
  6510.            begin
  6511.               sym:=pd^.publicsyms^.search(n);
  6512.               if assigned(sym) then
  6513.                 break;
  6514.               pd:=pd^.childof;
  6515.            end;
  6516.          search_class_member:=sym;
  6517.       end;
  6518.  
  6519.    var
  6520.       _defaultprop : ppropertysym;
  6521.  
  6522.    procedure testfordefaultproperty(p : psym);
  6523.  
  6524.      begin
  6525.         if (p^.typ=propertysym) and ((ppropertysym(p)^.options and ppo_defaultproperty)<>0) then
  6526.           _defaultprop:=ppropertysym(p);
  6527.      end;
  6528.  
  6529.    function search_default_property(pd : pobjectdef) : ppropertysym;
  6530.  
  6531.      begin
  6532.         _defaultprop:=nil;
  6533.         while assigned(pd) do
  6534.           begin
  6535. {$ifdef tp}
  6536.              pd^.publicsyms^.foreach(testfordefaultproperty);
  6537. {$else}
  6538.              pd^.publicsyms^.foreach(@testfordefaultproperty);
  6539. {$endif}
  6540.              if assigned(_defaultprop) then
  6541.                break;
  6542.              pd:=pd^.childof;
  6543.           end;
  6544.         search_default_property:=_defaultprop;
  6545.      end;
  6546.  
  6547.    procedure init_symtable;
  6548.  
  6549.      begin
  6550.         registerdef:=false;
  6551.         read_member:=false;
  6552.         generrorsym:=new(perrorsym,init);
  6553.         swurzel:=nil;
  6554.         { readunit_lastloaded:=nil; }
  6555. {$ifdef GDB}
  6556.         firstglobaldef:=nil;
  6557.         lastglobaldef:=nil;
  6558. {$endif GDB}
  6559.         commandlinedefines.init;
  6560.         globaltypecount:=1;
  6561.         pglobaltypecount:=@globaltypecount;
  6562.      end;
  6563.  
  6564.    procedure reset_gdb_info;
  6565.      var def : pdef;
  6566.      begin
  6567. {$ifdef GDB }
  6568.         def:=firstglobaldef;
  6569.         GlobalTypeCount:=1;
  6570.         pglobaltypecount:=@globaltypecount;
  6571.         while assigned(def) do
  6572.           begin
  6573.               if assigned(def^.sym) then
  6574.                 begin
  6575.                    { was a check
  6576.  
  6577.                    write('Type: ',longint(def^.deftype));
  6578.                    if def^.deftype=procdef then
  6579.                      write(' mangle name: ',pprocdef(def)^.mangledname);
  6580.                    }
  6581.                    if def^.sym^.typ=typesym then
  6582.                      def^.sym^.isusedinstab:=false;
  6583.                    {
  6584.                    writeln(' Name: ',def^.sym^.name);
  6585.                    }
  6586.                 end;
  6587.               def^.isstabwritten:=false;
  6588.               def^.globalnb:=0;
  6589.               if (def^.deftype=orddef) then
  6590.                 porddef(def)^.rangenr:=0;
  6591.               if (def^.deftype=arraydef) then
  6592.                 parraydef(def)^.rangenr:=0;
  6593.               def:=def^.nextglobal;
  6594.           end;
  6595. {$endif GDB }
  6596.      end;
  6597.  
  6598.    procedure done_symtable;
  6599.  
  6600.       begin
  6601.         dispose(generrorsym,done);
  6602.         dispose_global:=true;
  6603.         while assigned(symtablestack) do dellexlevel;
  6604. {$ifndef GDB}
  6605.         dispose(generrordef,done);
  6606.         dispose(s32bitdef,done);
  6607.         dispose(u32bitdef,done);
  6608.         dispose(cstringdef,done);
  6609.      {$ifdef UseLongString}
  6610.         dispose(clongstringdef,done);
  6611.      {$endif UseLongString}
  6612.      {$ifdef UseAnsiString}
  6613.         dispose(cansistringdef,done);
  6614.      {$endif UseAnsiString}
  6615.         dispose(cchardef,done);
  6616.         {dispose(cs64realdef,done);}
  6617.         {dispose(voiddef,done); belongs to system !}
  6618.         dispose(u8bitdef,done);
  6619.         dispose(u16bitdef,done);
  6620.         dispose(booldef,done);
  6621.         dispose(voidpointerdef,done);
  6622.         dispose(cfiledef,done);
  6623. {$endif GDB}
  6624.         commandlinedefines.done;
  6625.      end;
  6626.  
  6627. var
  6628.   i : ttoken;
  6629. begin
  6630.    { no operator is overloaded }
  6631.    for i:=PLUS to last_overloaded do
  6632.      overloaded_operators[i]:=nil;
  6633. end.
  6634. {
  6635.   $Log: symtable.pas,v $
  6636.   Revision 1.1.1.1.2.4  1998/08/13 17:41:28  florian
  6637.     + some stuff for the PalmOS added
  6638.  
  6639.   Revision 1.1.1.1.2.3  1998/08/13 13:26:04  carl
  6640.     + support for Big endian reading of units
  6641.  
  6642.   Revision 1.1.1.1.2.2  1998/05/21 12:22:12  carl
  6643.     * bugfix of handle sizes for m68k systems
  6644.  
  6645.   Revision 1.1.1.1.2.1  1998/04/08 11:38:44  peter
  6646.     * nasm patches, pierres symtable patch
  6647.  
  6648.   Revision 1.1.1.1  1998/03/25 11:18:15  root
  6649.   * Restored version
  6650.  
  6651.   Revision 1.49  1998/03/24 21:48:36  florian
  6652.     * just a couple of fixes applied:
  6653.          - problem with fixed16 solved
  6654.          - internalerror 10005 problem fixed
  6655.          - patch for assembler reading
  6656.          - small optimizer fix
  6657.          - mem is now supported
  6658.  
  6659.   Revision 1.48  1998/03/21 23:59:39  florian
  6660.     * indexed properties fixed
  6661.     * ppu i/o of properties fixed
  6662.     * field can be also used for write access
  6663.     * overriding of properties
  6664.  
  6665.   Revision 1.47  1998/03/10 16:27:45  pierre
  6666.     * better line info in stabs debug
  6667.     * symtabletype and lexlevel separated into two fields of tsymtable
  6668.     + ifdef MAKELIB for direct library output, not complete
  6669.     + ifdef CHAINPROCSYMS for overloaded seach across units, not fully
  6670.       working
  6671.     + ifdef TESTFUNCRET for setting func result in underfunction, not
  6672.       working
  6673.  
  6674.   Revision 1.46  1998/03/10 01:17:28  peter
  6675.     * all files have the same header
  6676.     * messages are fully implemented, EXTDEBUG uses Comment()
  6677.     + AG... files for the Assembler generation
  6678.  
  6679.   Revision 1.45  1998/03/06 00:52:56  peter
  6680.     * replaced all old messages from errore.msg, only ExtDebug and some
  6681.       Comment() calls are left
  6682.     * fixed options.pas
  6683.  
  6684.   Revision 1.44  1998/03/04 17:34:09  michael
  6685.   + Changed ifdef FPK to ifdef FPC
  6686.  
  6687.   Revision 1.43  1998/03/04 01:35:12  peter
  6688.     * messages for unit-handling and assembler/linker
  6689.     * the compiler compiles without -dGDB, but doesn't work yet
  6690.     + -vh for Hint
  6691.  
  6692.   Revision 1.42  1998/03/03 23:18:49  florian
  6693.     * ret $8 problem with unit init/main program fixed
  6694.  
  6695.   Revision 1.41  1998/03/02 01:49:30  peter
  6696.     * renamed target_DOS to target_GO32V1
  6697.     + new verbose system, merged old errors and verbose units into one new
  6698.       verbose.pas, so errors.pas is obsolete
  6699.  
  6700.   Revision 1.40  1998/03/01 22:46:22  florian
  6701.     + some win95 linking stuff
  6702.     * a couple of bugs fixed:
  6703.       bug0055,bug0058,bug0059,bug0064,bug0072,bug0093,bug0095,bug0098
  6704.  
  6705.   Revision 1.39  1998/02/27 21:24:15  florian
  6706.     * dll support changed (dll name can be also a string contants)
  6707.  
  6708.   Revision 1.38  1998/02/27 09:26:10  daniel
  6709.   * Changed symtable handling so no junk symtable is put on the symtablestack.
  6710.  
  6711.   Revision 1.37  1998/02/24 15:36:27  daniel
  6712.   + Added owner:=nil to Tsym.init. Caused problems with TP compiling.
  6713.  
  6714.   Revision 1.36  1998/02/24 14:20:58  peter
  6715.     + tstringcontainer.empty
  6716.     * ld -T option restored for linux
  6717.     * libraries are placed before the objectfiles in a .PPU file
  6718.     * removed 'uses link' from files.pas
  6719.  
  6720.   Revision 1.35  1998/02/22 23:03:36  peter
  6721.     * renamed msource->mainsource and name->unitname
  6722.     * optimized filename handling, filename is not seperate anymore with
  6723.       path+name+ext, this saves stackspace and a lot of fsplit()'s
  6724.     * recompiling of some units in libraries fixed
  6725.     * shared libraries are working again
  6726.     + $LINKLIB <lib> to support automatic linking to libraries
  6727.     + libraries are saved/read from the ppufile, also allows more libraries
  6728.       per ppufile
  6729.  
  6730.   Revision 1.34  1998/02/17 21:21:01  peter
  6731.     + Script unit
  6732.     + __EXIT is called again to exit a program
  6733.     - target_info.link/assembler calls
  6734.     * linking works again for dos
  6735.     * optimized a few filehandling functions
  6736.     * fixed stabs generation for procedures
  6737.  
  6738.   Revision 1.33  1998/02/16 12:51:50  michael
  6739.   + Implemented linker object
  6740.  
  6741.   Revision 1.32  1998/02/14 01:45:32  peter
  6742.     * more fixes
  6743.     - pmode target is removed
  6744.     - search_as_ld is removed, this is done in the link.pas/assemble.pas
  6745.     + findexe() to search for an executable (linker,assembler,binder)
  6746.  
  6747.   Revision 1.31  1998/02/13 22:26:40  peter
  6748.     * fixed a few SigSegv's
  6749.     * INIT$$ was not written for linux!
  6750.     * assembling and linking works again for linux and dos
  6751.     + assembler object, only attasmi3 supported yet
  6752.     * restore pp.pas with AddPath etc.
  6753.  
  6754.   Revision 1.30  1998/02/13 10:35:47  daniel
  6755.   * Made Motorola version compilable.
  6756.   * Fixed optimizer
  6757.  
  6758.   Revision 1.29  1998/02/12 17:19:28  florian
  6759.     * fixed to get remake3 work, but needs additional fixes (output, I don't like
  6760.       also that aktswitches isn't a pointer)
  6761.  
  6762.   Revision 1.28  1998/02/12 11:50:47  daniel
  6763.   Yes! Finally! After three retries, my patch!
  6764.  
  6765.   Changes:
  6766.  
  6767.   Complete rewrite of psub.pas.
  6768.   Added support for DLL's.
  6769.   Compiler requires less memory.
  6770.   Platform units for each platform.
  6771.  
  6772.   Revision 1.27  1998/02/07 23:05:06  florian
  6773.     * once more MMX
  6774.  
  6775.   Revision 1.26  1998/02/07 06:49:14  carl
  6776.     * small fixes to make it compile with non-386 targets
  6777.  
  6778.   Revision 1.25  1998/02/06 23:08:34  florian
  6779.     + endian to targetinfo and sourceinfo added
  6780.     + endian independed writing of ppu file (reading missed), a PPU file
  6781.       is written with the target endian
  6782.  
  6783.   Revision 1.24  1998/02/06 10:34:29  florian
  6784.     * bug0082 and bug0084 fixed
  6785.  
  6786.   Revision 1.23  1998/02/03 22:13:36  florian
  6787.     * clean up
  6788.  
  6789.   Revision 1.22  1998/02/02 23:39:58  florian
  6790.     * forward classes are now allowed without resolving (see sysutils)
  6791.  
  6792.   Revision 1.21  1998/02/02 00:55:35  peter
  6793.     * defdatei -> deffile and some german comments to english
  6794.     * search() accepts : as seperater under linux
  6795.     * search for ppc.cfg doesn't open a file (and let it open)
  6796.     * reorganize the reading of parameters/file a bit
  6797.     * all the PPC_ environments are now for all platforms
  6798.  
  6799.   Revision 1.20  1998/02/01 15:03:01  florian
  6800.     * small improvement of tobjectdef.isrelated
  6801.  
  6802.   Revision 1.19  1998/01/30 17:31:27  pierre
  6803.     * bug of cyclic symtablestack fixed
  6804.  
  6805.   Revision 1.18  1998/01/27 22:02:35  florian
  6806.     * small bug fix to the compiler work, I forgot a not(...):(
  6807.  
  6808.   Revision 1.17  1998/01/25 22:29:05  florian
  6809.     * a lot bug fixes on the DOM
  6810.  
  6811.   Revision 1.16  1998/01/23 17:12:21  pierre
  6812.     * added some improvements for as and ld :
  6813.       - doserror and dosexitcode treated separately
  6814.       - PATH searched if doserror=2
  6815.     + start of long and ansi string (far from complete)
  6816.       in conditionnal UseLongString and UseAnsiString
  6817.     * options.pas cleaned (some variables shifted to globals)gl
  6818.  
  6819.   Revision 1.15  1998/01/21 21:29:57  florian
  6820.     * some fixes for Delphi classes
  6821.  
  6822.   Revision 1.14  1998/01/16 18:03:19  florian
  6823.     * small bug fixes, some stuff of delphi styled constructores added
  6824.  
  6825.   Revision 1.13  1998/01/16 11:24:28  florian
  6826.     + problem with absolute syms in unit files solved
  6827.  
  6828.   Revision 1.12  1998/01/16 10:33:18  florian
  6829.     * bug0077 fixed (problem when reading absolute syms from a unit file)
  6830.  
  6831.   Revision 1.11  1998/01/13 23:04:17  florian
  6832.     * the options member of procdefs, objectdefs and propertysyms is
  6833.       noew longint => unit format changed
  6834.  
  6835.   Revision 1.10  1998/01/13 17:13:10  michael
  6836.     * File time handling and file searching is now done in an OS-independent way,
  6837.       using the new file treating functions in globals.pas.
  6838.  
  6839.   Revision 1.9  1998/01/11 04:15:34  carl
  6840.     * alignment problem fix for m68k
  6841.  
  6842.   Revision 1.8  1998/01/10 11:10:42  florian
  6843.     + procedure flag poclassmethod for class methods
  6844.  
  6845.   Revision 1.7  1998/01/09 23:08:36  florian
  6846.     + C++/Delphi styled //-comments
  6847.     * some bugs in Delphi object model fixed
  6848.     + override directive
  6849.  
  6850.   Revision 1.6  1998/01/09 13:18:13  florian
  6851.     + "forward" class declarations   (type tclass = class; )
  6852.  
  6853.   Revision 1.5  1998/01/07 00:17:06  michael
  6854.   Restored released version (plus fixes) as current
  6855.  
  6856.   Revision 1.3  1997/12/09 14:10:52  carl
  6857.   + merged both m68k and intel float types
  6858.  
  6859.   Revision 1.2  1997/12/03 13:57:45  carl
  6860.   + writexxx and readxxx now use sizeof(xxxx)
  6861.   (except for sets).
  6862.  
  6863.   Revision 1.1.1.1  1997/11/27 08:33:02  michael
  6864.   FPC Compiler CVS start
  6865.  
  6866.  
  6867.   Pre-CVS log:
  6868.  
  6869.  
  6870.   CEC    Carl-Eric Codere
  6871.   FK     Florian Klaempfl
  6872.   PM     Pierre Muller
  6873.   +      feature added
  6874.   -      removed
  6875.   *      bug fixed or changed
  6876.  
  6877.   History (started with version 0.9.0):
  6878.        7th december 1996
  6879.          * the call offset is now saved in call_offset and not in name   (FK)
  6880.       26th december 1996
  6881.          + new PPU file handling   (FK)
  6882.       26th february 1997
  6883.          + fixed comma numbers   (FK)
  6884.       5th september 1997
  6885.          * fixed a little missing i386
  6886.            define for s64bit on line: 3609   (CEC)
  6887.          + works with m68k unit   (CEC)
  6888.      17th september 1997
  6889.          * type t=^b; b=byte;
  6890.            works now   (FK)
  6891.      25th september 1997:
  6892.          + getsize handles now open arrays (FK)
  6893.      1th october 1997
  6894.          + adding assignment to overloadable operators (PM)
  6895.      3rd october 1997:
  6896.          + created one tfloattype for m68k. Find all ifdef m68k and
  6897.            tfloatdef methods modified also (CEC)
  6898.       4th october 1997:
  6899.          + added has_jump in enumdef for use in in_succ_x and in_pred_x (PM)
  6900.       13th october 1997:
  6901.          + added static modifier for objects variable and methods (PM)
  6902.       25th october 1997:
  6903.          + small sets released (FK)
  6904.       19th november 1997:
  6905.          + tfiledef.setsize for win32 (FK)
  6906.       20th november 1997:
  6907.          + added  argconvtyp to tdefcoll (PM)
  6908. }
  6909.  
  6910.